floraachy
/
OpenBLAS
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Add support for INTERFACE64 and fix XERBLA calls 

1. Replaced all instances of "int" with "blasint"
2. Added string length as "hidden" third parameter in calls to fortran XERBLA
This commit is contained in:
Martin Kroeker 2019-04-27 19:06:00 +02:00 committed by GitHub
parent 9a19616a28
commit 798c448b0c
74 changed files with 2001 additions and 1982 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

88
relapack/src/blas.h
View File

@ -1,61 +1,61 @@
#ifndef BLAS_H #ifndef BLAS_H
#define BLAS_H #define BLAS_H
extern void BLAS(sswap)(const int *, float *, const int *, float *, const int *); extern void BLAS(sswap)(const blasint *, float *, const blasint *, float *, const blasint *);
extern void BLAS(dswap)(const int *, double *, const int *, double *, const int *); extern void BLAS(dswap)(const blasint *, double *, const blasint *, double *, const blasint *);
extern void BLAS(cswap)(const int *, float *, const int *, float *, const int *); extern void BLAS(cswap)(const blasint *, float *, const blasint *, float *, const blasint *);
extern void BLAS(zswap)(const int *, double *, const int *, double *, const int *); extern void BLAS(zswap)(const blasint *, double *, const blasint *, double *, const blasint *);
extern void BLAS(sscal)(const int *, const float *, float *, const int *); extern void BLAS(sscal)(const blasint *, const float *, float *, const blasint *);
extern void BLAS(dscal)(const int *, const double *, double *, const int *); extern void BLAS(dscal)(const blasint *, const double *, double *, const blasint *);
extern void BLAS(cscal)(const int *, const float *, float *, const int *); extern void BLAS(cscal)(const blasint *, const float *, float *, const blasint *);
extern void BLAS(zscal)(const int *, const double *, double *, const int *); extern void BLAS(zscal)(const blasint *, const double *, double *, const blasint *);
extern void BLAS(saxpy)(const int *, const float *, const float *, const int *, float *, const int *); extern void BLAS(saxpy)(const blasint *, const float *, const float *, const blasint *, float *, const blasint *);
extern void BLAS(daxpy)(const int *, const double *, const double *, const int *, double *, const int *); extern void BLAS(daxpy)(const blasint *, const double *, const double *, const blasint *, double *, const blasint *);
extern void BLAS(caxpy)(const int *, const float *, const float *, const int *, float *, const int *); extern void BLAS(caxpy)(const blasint *, const float *, const float *, const blasint *, float *, const blasint *);
extern void BLAS(zaxpy)(const int *, const double *, const double *, const int *, double *, const int *); extern void BLAS(zaxpy)(const blasint *, const double *, const double *, const blasint *, double *, const blasint *);
extern void BLAS(sgemv)(const char *, const int *, const int *, const float *, const float *, const int *, const float *, const int *, const float *, const float *, const int*); extern void BLAS(sgemv)(const char *, const blasint *, const blasint *, const float *, const float *, const blasint *, const float *, const blasint *, const float *, const float *, const blasint*);
extern void BLAS(dgemv)(const char *, const int *, const int *, const double *, const double *, const int *, const double *, const int *, const double *, const double *, const int*); extern void BLAS(dgemv)(const char *, const blasint *, const blasint *, const double *, const double *, const blasint *, const double *, const blasint *, const double *, const double *, const blasint*);
extern void BLAS(cgemv)(const char *, const int *, const int *, const float *, const float *, const int *, const float *, const int *, const float *, const float *, const int*); extern void BLAS(cgemv)(const char *, const blasint *, const blasint *, const float *, const float *, const blasint *, const float *, const blasint *, const float *, const float *, const blasint*);
extern void BLAS(zgemv)(const char *, const int *, const int *, const double *, const double *, const int *, const double *, const int *, const double *, const double *, const int*); extern void BLAS(zgemv)(const char *, const blasint *, const blasint *, const double *, const double *, const blasint *, const double *, const blasint *, const double *, const double *, const blasint*);
extern void BLAS(sgemm)(const char *, const char *, const int *, const int *, const int *, const float *, const float *, const int *, const float *, const int *, const float *, const float *, const int*); extern void BLAS(sgemm)(const char *, const char *, const blasint *, const blasint *, const blasint *, const float *, const float *, const blasint *, const float *, const blasint *, const float *, const float *, const blasint*);
extern void BLAS(dgemm)(const char *, const char *, const int *, const int *, const int *, const double *, const double *, const int *, const double *, const int *, const double *, const double *, const int*); extern void BLAS(dgemm)(const char *, const char *, const blasint *, const blasint *, const blasint *, const double *, const double *, const blasint *, const double *, const blasint *, const double *, const double *, const blasint*);
extern void BLAS(cgemm)(const char *, const char *, const int *, const int *, const int *, const float *, const float *, const int *, const float *, const int *, const float *, const float *, const int*); extern void BLAS(cgemm)(const char *, const char *, const blasint *, const blasint *, const blasint *, const float *, const float *, const blasint *, const float *, const blasint *, const float *, const float *, const blasint*);
extern void BLAS(zgemm)(const char *, const char *, const int *, const int *, const int *, const double *, const double *, const int *, const double *, const int *, const double *, const double *, const int*); extern void BLAS(zgemm)(const char *, const char *, const blasint *, const blasint *, const blasint *, const double *, const double *, const blasint *, const double *, const blasint *, const double *, const double *, const blasint*);
extern void BLAS(strsm)(const char *, const char *, const char *, const char *, const int *, const int *, const float *, const float *, const int *, float *, const int *); extern void BLAS(strsm)(const char *, const char *, const char *, const char *, const blasint *, const blasint *, const float *, const float *, const blasint *, float *, const blasint *);
extern void BLAS(dtrsm)(const char *, const char *, const char *, const char *, const int *, const int *, const double *, const double *, const int *, double *, const int *); extern void BLAS(dtrsm)(const char *, const char *, const char *, const char *, const blasint *, const blasint *, const double *, const double *, const blasint *, double *, const blasint *);
extern void BLAS(ctrsm)(const char *, const char *, const char *, const char *, const int *, const int *, const float *, const float *, const int *, float *, const int *); extern void BLAS(ctrsm)(const char *, const char *, const char *, const char *, const blasint *, const blasint *, const float *, const float *, const blasint *, float *, const blasint *);
extern void BLAS(ztrsm)(const char *, const char *, const char *, const char *, const int *, const int *, const double *, const double *, const int *, double *, const int *); extern void BLAS(ztrsm)(const char *, const char *, const char *, const char *, const blasint *, const blasint *, const double *, const double *, const blasint *, double *, const blasint *);
extern void BLAS(strmm)(const char *, const char *, const char *, const char *, const int *, const int *, const float *, const float *, const int *, float *, const int *); extern void BLAS(strmm)(const char *, const char *, const char *, const char *, const blasint *, const blasint *, const float *, const float *, const blasint *, float *, const blasint *);
extern void BLAS(dtrmm)(const char *, const char *, const char *, const char *, const int *, const int *, const double *, const double *, const int *, double *, const int *); extern void BLAS(dtrmm)(const char *, const char *, const char *, const char *, const blasint *, const blasint *, const double *, const double *, const blasint *, double *, const blasint *);
extern void BLAS(ctrmm)(const char *, const char *, const char *, const char *, const int *, const int *, const float *, const float *, const int *, float *, const int *); extern void BLAS(ctrmm)(const char *, const char *, const char *, const char *, const blasint *, const blasint *, const float *, const float *, const blasint *, float *, const blasint *);
extern void BLAS(ztrmm)(const char *, const char *, const char *, const char *, const int *, const int *, const double *, const double *, const int *, double *, const int *); extern void BLAS(ztrmm)(const char *, const char *, const char *, const char *, const blasint *, const blasint *, const double *, const double *, const blasint *, double *, const blasint *);
extern void BLAS(ssyrk)(const char *, const char *, const int *, const int *, const float *, float *, const int *, const float *, float *, const int *); extern void BLAS(ssyrk)(const char *, const char *, const blasint *, const blasint *, const float *, float *, const blasint *, const float *, float *, const blasint *);
extern void BLAS(dsyrk)(const char *, const char *, const int *, const int *, const double *, double *, const int *, const double *, double *, const int *); extern void BLAS(dsyrk)(const char *, const char *, const blasint *, const blasint *, const double *, double *, const blasint *, const double *, double *, const blasint *);
extern void BLAS(cherk)(const char *, const char *, const int *, const int *, const float *, float *, const int *, const float *, float *, const int *); extern void BLAS(cherk)(const char *, const char *, const blasint *, const blasint *, const float *, float *, const blasint *, const float *, float *, const blasint *);
extern void BLAS(zherk)(const char *, const char *, const int *, const int *, const double *, double *, const int *, const double *, double *, const int *); extern void BLAS(zherk)(const char *, const char *, const blasint *, const blasint *, const double *, double *, const blasint *, const double *, double *, const blasint *);
extern void BLAS(ssymm)(const char *, const char *, const int *, const int *, const float *, const float *, const int *, const float *, const int *, const float *, float *, const int *); extern void BLAS(ssymm)(const char *, const char *, const blasint *, const blasint *, const float *, const float *, const blasint *, const float *, const blasint *, const float *, float *, const blasint *);
extern void BLAS(dsymm)(const char *, const char *, const int *, const int *, const double *, const double *, const int *, const double *, const int *, const double *, double *, const int *); extern void BLAS(dsymm)(const char *, const char *, const blasint *, const blasint *, const double *, const double *, const blasint *, const double *, const blasint *, const double *, double *, const blasint *);
extern void BLAS(chemm)(const char *, const char *, const int *, const int *, const float *, const float *, const int *, const float *, const int *, const float *, float *, const int *); extern void BLAS(chemm)(const char *, const char *, const blasint *, const blasint *, const float *, const float *, const blasint *, const float *, const blasint *, const float *, float *, const blasint *);
extern void BLAS(zhemm)(const char *, const char *, const int *, const int *, const double *, const double *, const int *, const double *, const int *, const double *, double *, const int *); extern void BLAS(zhemm)(const char *, const char *, const blasint *, const blasint *, const double *, const double *, const blasint *, const double *, const blasint *, const double *, double *, const blasint *);
extern void BLAS(ssyr2k)(const char *, const char *, const int *, const int *, const float *, const float *, const int *, const float *, const int *, const float *, float *, const int *); extern void BLAS(ssyr2k)(const char *, const char *, const blasint *, const blasint *, const float *, const float *, const blasint *, const float *, const blasint *, const float *, float *, const blasint *);
extern void BLAS(dsyr2k)(const char *, const char *, const int *, const int *, const double *, const double *, const int *, const double *, const int *, const double *, double *, const int *); extern void BLAS(dsyr2k)(const char *, const char *, const blasint *, const blasint *, const double *, const double *, const blasint *, const double *, const blasint *, const double *, double *, const blasint *);
extern void BLAS(cher2k)(const char *, const char *, const int *, const int *, const float *, const float *, const int *, const float *, const int *, const float *, float *, const int *); extern void BLAS(cher2k)(const char *, const char *, const blasint *, const blasint *, const float *, const float *, const blasint *, const float *, const blasint *, const float *, float *, const blasint *);
extern void BLAS(zher2k)(const char *, const char *, const int *, const int *, const double *, const double *, const int *, const double *, const int *, const double *, double *, const int *); extern void BLAS(zher2k)(const char *, const char *, const blasint *, const blasint *, const double *, const double *, const blasint *, const double *, const blasint *, const double *, double *, const blasint *);
#if HAVE_XGEMMT #if HAVE_XGEMMT
extern void BLAS(sgemmt)(const char *, const char *, const char *, const int *, const int *, const float *, const float *, const int *, const float *, const int *, const float *, const float *, const int*); extern void BLAS(sgemmt)(const char *, const char *, const char *, const blasint *, const blasint *, const float *, const float *, const blasint *, const float *, const blasint *, const float *, const float *, const blasint*);
extern void BLAS(dgemmt)(const char *, const char *, const char *, const int *, const int *, const double *, const double *, const int *, const double *, const int *, const double *, const double *, const int*); extern void BLAS(dgemmt)(const char *, const char *, const char *, const blasint *, const blasint *, const double *, const double *, const blasint *, const double *, const blasint *, const double *, const double *, const blasint*);
extern void BLAS(cgemmt)(const char *, const char *, const char *, const int *, const int *, const float *, const float *, const int *, const float *, const int *, const float *, const float *, const int*); extern void BLAS(cgemmt)(const char *, const char *, const char *, const blasint *, const blasint *, const float *, const float *, const blasint *, const float *, const blasint *, const float *, const float *, const blasint*);
extern void BLAS(zgemmt)(const char *, const char *, const char *, const int *, const int *, const double *, const double *, const int *, const double *, const int *, const double *, const double *, const int*); extern void BLAS(zgemmt)(const char *, const char *, const char *, const blasint *, const blasint *, const double *, const double *, const blasint *, const double *, const blasint *, const double *, const double *, const blasint*);
#endif #endif
#endif /* BLAS_H */ #endif /* BLAS_H */

78
relapack/src/cgbtrf.c
View File

@ -1,9 +1,9 @@
#include "relapack.h" #include "relapack.h"
#include "stdlib.h" #include "stdlib.h"
static void RELAPACK_cgbtrf_rec(const int *, const int *, const int *, static void RELAPACK_cgbtrf_rec(const blasint *, const blasint *, const blasint *,
const int *, float *, const int *, int *, float *, const int *, float *, const blasint *, float *, const blasint *, blasint *, float *, const blasint *, float *,
const int *, int *); const blasint *, blasint *);
/** CGBTRF computes an LU factorization of a complex m-by-n band matrix A using partial pivoting with row interchanges. /** CGBTRF computes an LU factorization of a complex m-by-n band matrix A using partial pivoting with row interchanges.
@ -13,9 +13,9 @@ static void RELAPACK_cgbtrf_rec(const int *, const int *, const int *,
* http://www.netlib.org/lapack/explore-html/d0/d3a/cgbtrf_8f.html * http://www.netlib.org/lapack/explore-html/d0/d3a/cgbtrf_8f.html
* */ * */
void RELAPACK_cgbtrf( void RELAPACK_cgbtrf(
const int *m, const int *n, const int *kl, const int *ku, const blasint *m, const blasint *n, const blasint *kl, const blasint *ku,
float *Ab, const int *ldAb, int *ipiv, float *Ab, const blasint *ldAb, blasint *ipiv,
int *info blasint *info
) { ) {
// Check arguments // Check arguments
@ -31,8 +31,8 @@ void RELAPACK_cgbtrf(
else if (*ldAb < 2 * *kl + *ku + 1) else if (*ldAb < 2 * *kl + *ku + 1)
*info = -6; *info = -6;
if (*info) { if (*info) {
const int minfo = -*info; const blasint minfo = -*info;
LAPACK(xerbla)("CGBTRF", &minfo); LAPACK(xerbla)("CGBTRF", &minfo, strlen("CGBTRF"));
return; return;
} }
@ -40,14 +40,14 @@ void RELAPACK_cgbtrf(
const float ZERO[] = { 0., 0. }; const float ZERO[] = { 0., 0. };
// Result upper band width // Result upper band width
const int kv = *ku + *kl; const blasint kv = *ku + *kl;
// Unskew A // Unskew A
const int ldA[] = { *ldAb - 1 }; const blasint ldA[] = { *ldAb - 1 };
float *const A = Ab + 2 * kv; float *const A = Ab + 2 * kv;
// Zero upper diagonal fill-in elements // Zero upper diagonal fill-in elements
int i, j; blasint i, j;
for (j = 0; j < *n; j++) { for (j = 0; j < *n; j++) {
float *const A_j = A + 2 * *ldA * j; float *const A_j = A + 2 * *ldA * j;
for (i = MAX(0, j - kv); i < j - *ku; i++) for (i = MAX(0, j - kv); i < j - *ku; i++)
@ -55,11 +55,11 @@ void RELAPACK_cgbtrf(
} }
// Allocate work space // Allocate work space
const int n1 = CREC_SPLIT(*n); const blasint n1 = CREC_SPLIT(*n);
const int mWorkl = (kv > n1) ? MAX(1, *m - *kl) : kv; const blasint mWorkl = (kv > n1) ? MAX(1, *m - *kl) : kv;
const int nWorkl = (kv > n1) ? n1 : kv; const blasint nWorkl = (kv > n1) ? n1 : kv;
const int mWorku = (*kl > n1) ? n1 : *kl; const blasint mWorku = (*kl > n1) ? n1 : *kl;
const int nWorku = (*kl > n1) ? MAX(0, *n - *kl) : *kl; const blasint nWorku = (*kl > n1) ? MAX(0, *n - *kl) : *kl;
float *Workl = malloc(mWorkl * nWorkl * 2 * sizeof(float)); float *Workl = malloc(mWorkl * nWorkl * 2 * sizeof(float));
float *Worku = malloc(mWorku * nWorku * 2 * sizeof(float)); float *Worku = malloc(mWorku * nWorku * 2 * sizeof(float));
LAPACK(claset)("L", &mWorkl, &nWorkl, ZERO, ZERO, Workl, &mWorkl); LAPACK(claset)("L", &mWorkl, &nWorkl, ZERO, ZERO, Workl, &mWorkl);
@ -76,10 +76,10 @@ void RELAPACK_cgbtrf(
/** cgbtrf's recursive compute kernel */ /** cgbtrf's recursive compute kernel */
static void RELAPACK_cgbtrf_rec( static void RELAPACK_cgbtrf_rec(
const int *m, const int *n, const int *kl, const int *ku, const blasint *m, const blasint *n, const blasint *kl, const blasint *ku,
float *Ab, const int *ldAb, int *ipiv, float *Ab, const blasint *ldAb, blasint *ipiv,
float *Workl, const int *ldWorkl, float *Worku, const int *ldWorku, float *Workl, const blasint *ldWorkl, float *Worku, const blasint *ldWorku,
int *info blasint *info
) { ) {
if (*n <= MAX(CROSSOVER_CGBTRF, 1)) { if (*n <= MAX(CROSSOVER_CGBTRF, 1)) {
@ -91,25 +91,25 @@ static void RELAPACK_cgbtrf_rec(
// Constants // Constants
const float ONE[] = { 1., 0. }; const float ONE[] = { 1., 0. };
const float MONE[] = { -1., 0. }; const float MONE[] = { -1., 0. };
const int iONE[] = { 1 }; const blasint iONE[] = { 1 };
// Loop iterators // Loop iterators
int i, j; blasint i, j;
// Output upper band width // Output upper band width
const int kv = *ku + *kl; const blasint kv = *ku + *kl;
// Unskew A // Unskew A
const int ldA[] = { *ldAb - 1 }; const blasint ldA[] = { *ldAb - 1 };
float *const A = Ab + 2 * kv; float *const A = Ab + 2 * kv;
// Splitting // Splitting
const int n1 = MIN(CREC_SPLIT(*n), *kl); const blasint n1 = MIN(CREC_SPLIT(*n), *kl);
const int n2 = *n - n1; const blasint n2 = *n - n1;
const int m1 = MIN(n1, *m); const blasint m1 = MIN(n1, *m);
const int m2 = *m - m1; const blasint m2 = *m - m1;
const int mn1 = MIN(m1, n1); const blasint mn1 = MIN(m1, n1);
const int mn2 = MIN(m2, n2); const blasint mn2 = MIN(m2, n2);
// Ab_L * // Ab_L *
// Ab_BR // Ab_BR
@ -129,14 +129,14 @@ static void RELAPACK_cgbtrf_rec(
// ipiv_T // ipiv_T
// ipiv_B // ipiv_B
int *const ipiv_T = ipiv; blasint *const ipiv_T = ipiv;
int *const ipiv_B = ipiv + n1; blasint *const ipiv_B = ipiv + n1;
// Banded splitting // Banded splitting
const int n21 = MIN(n2, kv - n1); const blasint n21 = MIN(n2, kv - n1);
const int n22 = MIN(n2 - n21, n1); const blasint n22 = MIN(n2 - n21, n1);
const int m21 = MIN(m2, *kl - m1); const blasint m21 = MIN(m2, *kl - m1);
const int m22 = MIN(m2 - m21, m1); const blasint m22 = MIN(m2 - m21, m1);
// n1 n21 n22 // n1 n21 n22
// m * A_Rl ARr // m * A_Rl ARr
@ -164,7 +164,7 @@ static void RELAPACK_cgbtrf_rec(
// partially redo swaps in A_L // partially redo swaps in A_L
for (i = 0; i < mn1; i++) { for (i = 0; i < mn1; i++) {
const int ip = ipiv_T[i] - 1; const blasint ip = ipiv_T[i] - 1;
if (ip != i) { if (ip != i) {
if (ip < *kl) if (ip < *kl)
BLAS(cswap)(&i, A_L + 2 * i, ldA, A_L + 2 * ip, ldA); BLAS(cswap)(&i, A_L + 2 * i, ldA, A_L + 2 * ip, ldA);
@ -180,7 +180,7 @@ static void RELAPACK_cgbtrf_rec(
for (j = 0; j < n22; j++) { for (j = 0; j < n22; j++) {
float *const A_Rrj = A_Rr + 2 * *ldA * j; float *const A_Rrj = A_Rr + 2 * *ldA * j;
for (i = j; i < mn1; i++) { for (i = j; i < mn1; i++) {
const int ip = ipiv_T[i] - 1; const blasint ip = ipiv_T[i] - 1;
if (ip != i) { if (ip != i) {
const float tmpr = A_Rrj[2 * i]; const float tmpr = A_Rrj[2 * i];
const float tmpc = A_Rrj[2 * i + 1]; const float tmpc = A_Rrj[2 * i + 1];
@ -211,7 +211,7 @@ static void RELAPACK_cgbtrf_rec(
// partially undo swaps in A_L // partially undo swaps in A_L
for (i = mn1 - 1; i >= 0; i--) { for (i = mn1 - 1; i >= 0; i--) {
const int ip = ipiv_T[i] - 1; const blasint ip = ipiv_T[i] - 1;
if (ip != i) { if (ip != i) {
if (ip < *kl) if (ip < *kl)
BLAS(cswap)(&i, A_L + 2 * i, ldA, A_L + 2 * ip, ldA); BLAS(cswap)(&i, A_L + 2 * i, ldA, A_L + 2 * ip, ldA);

66
relapack/src/cgemmt.c
View File

@ -1,12 +1,12 @@
#include "relapack.h" #include "relapack.h"
static void RELAPACK_cgemmt_rec(const char *, const char *, const char *, static void RELAPACK_cgemmt_rec(const char *, const char *, const char *,
const int *, const int *, const float *, const float *, const int *, const blasint *, const blasint *, const float *, const float *, const blasint *,
const float *, const int *, const float *, float *, const int *); const float *, const blasint *, const float *, float *, const blasint *);
static void RELAPACK_cgemmt_rec2(const char *, const char *, const char *, static void RELAPACK_cgemmt_rec2(const char *, const char *, const char *,
const int *, const int *, const float *, const float *, const int *, const blasint *, const blasint *, const float *, const float *, const blasint *,
const float *, const int *, const float *, float *, const int *); const float *, const blasint *, const float *, float *, const blasint *);
/** CGEMMT computes a matrix-matrix product with general matrices but updates /** CGEMMT computes a matrix-matrix product with general matrices but updates
@ -20,10 +20,10 @@ static void RELAPACK_cgemmt_rec2(const char *, const char *, const char *,
* */ * */
void RELAPACK_cgemmt( void RELAPACK_cgemmt(
const char *uplo, const char *transA, const char *transB, const char *uplo, const char *transA, const char *transB,
const int *n, const int *k, const blasint *n, const blasint *k,
const float *alpha, const float *A, const int *ldA, const float *alpha, const float *A, const blasint *ldA,
const float *B, const int *ldB, const float *B, const blasint *ldB,
const float *beta, float *C, const int *ldC const float *beta, float *C, const blasint *ldC
) { ) {
#if HAVE_XGEMMT #if HAVE_XGEMMT
@ -32,15 +32,15 @@ void RELAPACK_cgemmt(
#else #else
// Check arguments // Check arguments
const int lower = LAPACK(lsame)(uplo, "L"); const blasint lower = LAPACK(lsame)(uplo, "L");
const int upper = LAPACK(lsame)(uplo, "U"); const blasint upper = LAPACK(lsame)(uplo, "U");
const int notransA = LAPACK(lsame)(transA, "N"); const blasint notransA = LAPACK(lsame)(transA, "N");
const int tranA = LAPACK(lsame)(transA, "T"); const blasint tranA = LAPACK(lsame)(transA, "T");
const int ctransA = LAPACK(lsame)(transA, "C"); const blasint ctransA = LAPACK(lsame)(transA, "C");
const int notransB = LAPACK(lsame)(transB, "N"); const blasint notransB = LAPACK(lsame)(transB, "N");
const int tranB = LAPACK(lsame)(transB, "T"); const blasint tranB = LAPACK(lsame)(transB, "T");
const int ctransB = LAPACK(lsame)(transB, "C"); const blasint ctransB = LAPACK(lsame)(transB, "C");
int info = 0; blasint info = 0;
if (!lower && !upper) if (!lower && !upper)
info = 1; info = 1;
else if (!tranA && !ctransA && !notransA) else if (!tranA && !ctransA && !notransA)
@ -58,7 +58,7 @@ void RELAPACK_cgemmt(
else if (*ldC < MAX(1, *n)) else if (*ldC < MAX(1, *n))
info = 13; info = 13;
if (info) { if (info) {
LAPACK(xerbla)("CGEMMT", &info); LAPACK(xerbla)("CGEMMT", &info, strlen("CGEMMT"));
return; return;
} }
@ -76,10 +76,10 @@ void RELAPACK_cgemmt(
/** cgemmt's recursive compute kernel */ /** cgemmt's recursive compute kernel */
static void RELAPACK_cgemmt_rec( static void RELAPACK_cgemmt_rec(
const char *uplo, const char *transA, const char *transB, const char *uplo, const char *transA, const char *transB,
const int *n, const int *k, const blasint *n, const blasint *k,
const float *alpha, const float *A, const int *ldA, const float *alpha, const float *A, const blasint *ldA,
const float *B, const int *ldB, const float *B, const blasint *ldB,
const float *beta, float *C, const int *ldC const float *beta, float *C, const blasint *ldC
) { ) {
if (*n <= MAX(CROSSOVER_CGEMMT, 1)) { if (*n <= MAX(CROSSOVER_CGEMMT, 1)) {
@ -89,8 +89,8 @@ static void RELAPACK_cgemmt_rec(
} }
// Splitting // Splitting
const int n1 = CREC_SPLIT(*n); const blasint n1 = CREC_SPLIT(*n);
const int n2 = *n - n1; const blasint n2 = *n - n1;
// A_T // A_T
// A_B // A_B
@ -126,16 +126,16 @@ static void RELAPACK_cgemmt_rec(
/** cgemmt's unblocked compute kernel */ /** cgemmt's unblocked compute kernel */
static void RELAPACK_cgemmt_rec2( static void RELAPACK_cgemmt_rec2(
const char *uplo, const char *transA, const char *transB, const char *uplo, const char *transA, const char *transB,
const int *n, const int *k, const blasint *n, const blasint *k,
const float *alpha, const float *A, const int *ldA, const float *alpha, const float *A, const blasint *ldA,
const float *B, const int *ldB, const float *B, const blasint *ldB,
const float *beta, float *C, const int *ldC const float *beta, float *C, const blasint *ldC
) { ) {
const int incB = (*transB == 'N') ? 1 : *ldB; const blasint incB = (*transB == 'N') ? 1 : *ldB;
const int incC = 1; const blasint incC = 1;
int i; blasint i;
for (i = 0; i < *n; i++) { for (i = 0; i < *n; i++) {
// A_0 // A_0
// A_i // A_i
@ -151,13 +151,13 @@ static void RELAPACK_cgemmt_rec2(
float *const C_ii = C + 2 * *ldC * i + 2 * i; float *const C_ii = C + 2 * *ldC * i + 2 * i;
if (*uplo == 'L') { if (*uplo == 'L') {
const int nmi = *n - i; const blasint nmi = *n - i;
if (*transA == 'N') if (*transA == 'N')
BLAS(cgemv)(transA, &nmi, k, alpha, A_i, ldA, B_i, &incB, beta, C_ii, &incC); BLAS(cgemv)(transA, &nmi, k, alpha, A_i, ldA, B_i, &incB, beta, C_ii, &incC);
else else
BLAS(cgemv)(transA, k, &nmi, alpha, A_i, ldA, B_i, &incB, beta, C_ii, &incC); BLAS(cgemv)(transA, k, &nmi, alpha, A_i, ldA, B_i, &incB, beta, C_ii, &incC);
} else { } else {
const int ip1 = i + 1; const blasint ip1 = i + 1;
if (*transA == 'N') if (*transA == 'N')
BLAS(cgemv)(transA, &ip1, k, alpha, A_0, ldA, B_i, &incB, beta, C_0i, &incC); BLAS(cgemv)(transA, &ip1, k, alpha, A_0, ldA, B_i, &incB, beta, C_0i, &incC);
else else

40
relapack/src/cgetrf.c
View File

@ -1,7 +1,7 @@
#include "relapack.h" #include "relapack.h"
static void RELAPACK_cgetrf_rec(const int *, const int *, float *, static void RELAPACK_cgetrf_rec(const blasint *, const blasint *, float *,
const int *, int *, int *); const blasint *, blasint *, blasint *);
/** CGETRF computes an LU factorization of a general M-by-N matrix A using partial pivoting with row interchanges. /** CGETRF computes an LU factorization of a general M-by-N matrix A using partial pivoting with row interchanges.
@ -11,9 +11,9 @@ static void RELAPACK_cgetrf_rec(const int *, const int *, float *,
* http://www.netlib.org/lapack/explore-html/d9/dfb/cgetrf_8f.html * http://www.netlib.org/lapack/explore-html/d9/dfb/cgetrf_8f.html
*/ */
void RELAPACK_cgetrf( void RELAPACK_cgetrf(
const int *m, const int *n, const blasint *m, const blasint *n,
float *A, const int *ldA, int *ipiv, float *A, const blasint *ldA, blasint *ipiv,
int *info blasint *info
) { ) {
// Check arguments // Check arguments
@ -25,12 +25,12 @@ void RELAPACK_cgetrf(
else if (*ldA < MAX(1, *n)) else if (*ldA < MAX(1, *n))
*info = -4; *info = -4;
if (*info) { if (*info) {
const int minfo = -*info; const blasint minfo = -*info;
LAPACK(xerbla)("CGETRF", &minfo); LAPACK(xerbla)("CGETRF", &minfo, strlen("CGETRF"));
return; return;
} }
const int sn = MIN(*m, *n); const blasint sn = MIN(*m, *n);
RELAPACK_cgetrf_rec(m, &sn, A, ldA, ipiv, info); RELAPACK_cgetrf_rec(m, &sn, A, ldA, ipiv, info);
@ -38,10 +38,10 @@ void RELAPACK_cgetrf(
if (*m < *n) { if (*m < *n) {
// Constants // Constants
const float ONE[] = { 1., 0. }; const float ONE[] = { 1., 0. };
const int iONE[] = { 1 }; const blasint iONE[] = { 1 };
// Splitting // Splitting
const int rn = *n - *m; const blasint rn = *n - *m;
// A_L A_R // A_L A_R
const float *const A_L = A; const float *const A_L = A;
@ -57,9 +57,9 @@ void RELAPACK_cgetrf(
/** cgetrf's recursive compute kernel */ /** cgetrf's recursive compute kernel */
static void RELAPACK_cgetrf_rec( static void RELAPACK_cgetrf_rec(
const int *m, const int *n, const blasint *m, const blasint *n,
float *A, const int *ldA, int *ipiv, float *A, const blasint *ldA, blasint *ipiv,
int *info blasint *info
) { ) {
if (*n <= MAX(CROSSOVER_CGETRF, 1)) { if (*n <= MAX(CROSSOVER_CGETRF, 1)) {
@ -71,12 +71,12 @@ static void RELAPACK_cgetrf_rec(
// Constants // Constants
const float ONE[] = { 1., 0. }; const float ONE[] = { 1., 0. };
const float MONE[] = { -1., 0. }; const float MONE[] = { -1., 0. };
const int iONE[] = { 1 }; const blasint iONE[] = { 1 };
// Splitting // Splitting
const int n1 = CREC_SPLIT(*n); const blasint n1 = CREC_SPLIT(*n);
const int n2 = *n - n1; const blasint n2 = *n - n1;
const int m2 = *m - n1; const blasint m2 = *m - n1;
// A_L A_R // A_L A_R
float *const A_L = A; float *const A_L = A;
@ -91,8 +91,8 @@ static void RELAPACK_cgetrf_rec(
// ipiv_T // ipiv_T
// ipiv_B // ipiv_B
int *const ipiv_T = ipiv; blasint *const ipiv_T = ipiv;
int *const ipiv_B = ipiv + n1; blasint *const ipiv_B = ipiv + n1;
// recursion(A_L, ipiv_T) // recursion(A_L, ipiv_T)
RELAPACK_cgetrf_rec(m, &n1, A_L, ldA, ipiv_T, info); RELAPACK_cgetrf_rec(m, &n1, A_L, ldA, ipiv_T, info);
@ -111,7 +111,7 @@ static void RELAPACK_cgetrf_rec(
// apply pivots to A_BL // apply pivots to A_BL
LAPACK(claswp)(&n1, A_BL, ldA, iONE, &n2, ipiv_B, iONE); LAPACK(claswp)(&n1, A_BL, ldA, iONE, &n2, ipiv_B, iONE);
// shift pivots // shift pivots
int i; blasint i;
for (i = 0; i < n2; i++) for (i = 0; i < n2; i++)
ipiv_B[i] += n1; ipiv_B[i] += n1;
} }

38
relapack/src/chegst.c
View File

@ -3,9 +3,9 @@
#include "stdlib.h" #include "stdlib.h"
#endif #endif
static void RELAPACK_chegst_rec(const int *, const char *, const int *, static void RELAPACK_chegst_rec(const blasint *, const char *, const blasint *,
float *, const int *, const float *, const int *, float *, const blasint *, const float *, const blasint *,
float *, const int *, int *); float *, const blasint *, blasint *);
/** CHEGST reduces a complex Hermitian-definite generalized eigenproblem to standard form. /** CHEGST reduces a complex Hermitian-definite generalized eigenproblem to standard form.
@ -15,14 +15,14 @@ static void RELAPACK_chegst_rec(const int *, const char *, const int *,
* http://www.netlib.org/lapack/explore-html/d7/d2a/chegst_8f.html * http://www.netlib.org/lapack/explore-html/d7/d2a/chegst_8f.html
* */ * */
void RELAPACK_chegst( void RELAPACK_chegst(
const int *itype, const char *uplo, const int *n, const blasint *itype, const char *uplo, const blasint *n,
float *A, const int *ldA, const float *B, const int *ldB, float *A, const blasint *ldA, const float *B, const blasint *ldB,
int *info blasint *info
) { ) {
// Check arguments // Check arguments
const int lower = LAPACK(lsame)(uplo, "L"); const blasint lower = LAPACK(lsame)(uplo, "L");
const int upper = LAPACK(lsame)(uplo, "U"); const blasint upper = LAPACK(lsame)(uplo, "U");
*info = 0; *info = 0;
if (*itype < 1 || *itype > 3) if (*itype < 1 || *itype > 3)
*info = -1; *info = -1;
@ -35,8 +35,8 @@ void RELAPACK_chegst(
else if (*ldB < MAX(1, *n)) else if (*ldB < MAX(1, *n))
*info = -7; *info = -7;
if (*info) { if (*info) {
const int minfo = -*info; const blasint minfo = -*info;
LAPACK(xerbla)("CHEGST", &minfo); LAPACK(xerbla)("CHEGST", &minfo, strlen("CHEGST"));
return; return;
} }
@ -45,9 +45,9 @@ void RELAPACK_chegst(
// Allocate work space // Allocate work space
float *Work = NULL; float *Work = NULL;
int lWork = 0; blasint lWork = 0;
#if XSYGST_ALLOW_MALLOC #if XSYGST_ALLOW_MALLOC
const int n1 = CREC_SPLIT(*n); const blasint n1 = CREC_SPLIT(*n);
lWork = n1 * (*n - n1); lWork = n1 * (*n - n1);
Work = malloc(lWork * 2 * sizeof(float)); Work = malloc(lWork * 2 * sizeof(float));
if (!Work) if (!Work)
@ -67,9 +67,9 @@ void RELAPACK_chegst(
/** chegst's recursive compute kernel */ /** chegst's recursive compute kernel */
static void RELAPACK_chegst_rec( static void RELAPACK_chegst_rec(
const int *itype, const char *uplo, const int *n, const blasint *itype, const char *uplo, const blasint *n,
float *A, const int *ldA, const float *B, const int *ldB, float *A, const blasint *ldA, const float *B, const blasint *ldB,
float *Work, const int *lWork, int *info float *Work, const blasint *lWork, blasint *info
) { ) {
if (*n <= MAX(CROSSOVER_CHEGST, 1)) { if (*n <= MAX(CROSSOVER_CHEGST, 1)) {
@ -84,14 +84,14 @@ static void RELAPACK_chegst_rec(
const float MONE[] = { -1., 0. }; const float MONE[] = { -1., 0. };
const float HALF[] = { .5, 0. }; const float HALF[] = { .5, 0. };
const float MHALF[] = { -.5, 0. }; const float MHALF[] = { -.5, 0. };
const int iONE[] = { 1 }; const blasint iONE[] = { 1 };
// Loop iterator // Loop iterator
int i; blasint i;
// Splitting // Splitting
const int n1 = CREC_SPLIT(*n); const blasint n1 = CREC_SPLIT(*n);
const int n2 = *n - n1; const blasint n2 = *n - n1;
// A_TL A_TR // A_TL A_TR
// A_BL A_BR // A_BL A_BR

72
relapack/src/chetrf.c
View File

@ -3,8 +3,8 @@
#include <stdlib.h> #include <stdlib.h>
#endif #endif
static void RELAPACK_chetrf_rec(const char *, const int *, const int *, int *, static void RELAPACK_chetrf_rec(const char *, const blasint *, const blasint *, blasint *,
float *, const int *, int *, float *, const int *, int *); float *, const blasint *, blasint *, float *, const blasint *, blasint *);
/** CHETRF computes the factorization of a complex Hermitian matrix A using the Bunch-Kaufman diagonal pivoting method. /** CHETRF computes the factorization of a complex Hermitian matrix A using the Bunch-Kaufman diagonal pivoting method.
@ -14,21 +14,21 @@ static void RELAPACK_chetrf_rec(const char *, const int *, const int *, int *,
* http://www.netlib.org/lapack/explore-html/da/dc1/chetrf_8f.html * http://www.netlib.org/lapack/explore-html/da/dc1/chetrf_8f.html
* */ * */
void RELAPACK_chetrf( void RELAPACK_chetrf(
const char *uplo, const int *n, const char *uplo, const blasint *n,
float *A, const int *ldA, int *ipiv, float *A, const blasint *ldA, blasint *ipiv,
float *Work, const int *lWork, int *info float *Work, const blasint *lWork, blasint *info
) { ) {
// Required work size // Required work size
const int cleanlWork = *n * (*n / 2); const blasint cleanlWork = *n * (*n / 2);
int minlWork = cleanlWork; blasint minlWork = cleanlWork;
#if XSYTRF_ALLOW_MALLOC #if XSYTRF_ALLOW_MALLOC
minlWork = 1; minlWork = 1;
#endif #endif
// Check arguments // Check arguments
const int lower = LAPACK(lsame)(uplo, "L"); const blasint lower = LAPACK(lsame)(uplo, "L");
const int upper = LAPACK(lsame)(uplo, "U"); const blasint upper = LAPACK(lsame)(uplo, "U");
*info = 0; *info = 0;
if (!lower && !upper) if (!lower && !upper)
*info = -1; *info = -1;
@ -55,8 +55,8 @@ void RELAPACK_chetrf(
#endif #endif
if (*info) { if (*info) {
const int minfo = -*info; const blasint minfo = -*info;
LAPACK(xerbla)("CHETRF", &minfo); LAPACK(xerbla)("CHETRF", &minfo, strlen("CHETRF"));
return; return;
} }
@ -64,7 +64,7 @@ void RELAPACK_chetrf(
const char cleanuplo = lower ? 'L' : 'U'; const char cleanuplo = lower ? 'L' : 'U';
// Dummy argument // Dummy argument
int nout; blasint nout;
// Recursive kernel // Recursive kernel
RELAPACK_chetrf_rec(&cleanuplo, n, n, &nout, A, ldA, ipiv, cleanWork, n, info); RELAPACK_chetrf_rec(&cleanuplo, n, n, &nout, A, ldA, ipiv, cleanWork, n, info);
@ -78,13 +78,13 @@ void RELAPACK_chetrf(
/** chetrf's recursive compute kernel */ /** chetrf's recursive compute kernel */
static void RELAPACK_chetrf_rec( static void RELAPACK_chetrf_rec(
const char *uplo, const int *n_full, const int *n, int *n_out, const char *uplo, const blasint *n_full, const blasint *n, blasint *n_out,
float *A, const int *ldA, int *ipiv, float *A, const blasint *ldA, blasint *ipiv,
float *Work, const int *ldWork, int *info float *Work, const blasint *ldWork, blasint *info
) { ) {
// top recursion level? // top recursion level?
const int top = *n_full == *n; const blasint top = *n_full == *n;
if (*n <= MAX(CROSSOVER_CHETRF, 3)) { if (*n <= MAX(CROSSOVER_CHETRF, 3)) {
// Unblocked // Unblocked
@ -96,31 +96,31 @@ static void RELAPACK_chetrf_rec(
return; return;
} }
int info1, info2; blasint info1, info2;
// Constants // Constants
const float ONE[] = { 1., 0. }; const float ONE[] = { 1., 0. };
const float MONE[] = { -1., 0. }; const float MONE[] = { -1., 0. };
const int iONE[] = { 1 }; const blasint iONE[] = { 1 };
const int n_rest = *n_full - *n; const blasint n_rest = *n_full - *n;
if (*uplo == 'L') { if (*uplo == 'L') {
// Splitting (setup) // Splitting (setup)
int n1 = CREC_SPLIT(*n); blasint n1 = CREC_SPLIT(*n);
int n2 = *n - n1; blasint n2 = *n - n1;
// Work_L * // Work_L *
float *const Work_L = Work; float *const Work_L = Work;
// recursion(A_L) // recursion(A_L)
int n1_out; blasint n1_out;
RELAPACK_chetrf_rec(uplo, n_full, &n1, &n1_out, A, ldA, ipiv, Work_L, ldWork, &info1); RELAPACK_chetrf_rec(uplo, n_full, &n1, &n1_out, A, ldA, ipiv, Work_L, ldWork, &info1);
n1 = n1_out; n1 = n1_out;
// Splitting (continued) // Splitting (continued)
n2 = *n - n1; n2 = *n - n1;
const int n_full2 = *n_full - n1; const blasint n_full2 = *n_full - n1;
// * * // * *
// A_BL A_BR // A_BL A_BR
@ -136,23 +136,23 @@ static void RELAPACK_chetrf_rec(
// (top recursion level: use Work as Work_BR) // (top recursion level: use Work as Work_BR)
float *const Work_BL = Work + 2 * n1; float *const Work_BL = Work + 2 * n1;
float *const Work_BR = top ? Work : Work + 2 * *ldWork * n1 + 2 * n1; float *const Work_BR = top ? Work : Work + 2 * *ldWork * n1 + 2 * n1;
const int ldWork_BR = top ? n2 : *ldWork; const blasint ldWork_BR = top ? n2 : *ldWork;
// ipiv_T // ipiv_T
// ipiv_B // ipiv_B
int *const ipiv_B = ipiv + n1; blasint *const ipiv_B = ipiv + n1;
// A_BR = A_BR - A_BL Work_BL' // A_BR = A_BR - A_BL Work_BL'
RELAPACK_cgemmt(uplo, "N", "T", &n2, &n1, MONE, A_BL, ldA, Work_BL, ldWork, ONE, A_BR, ldA); RELAPACK_cgemmt(uplo, "N", "T", &n2, &n1, MONE, A_BL, ldA, Work_BL, ldWork, ONE, A_BR, ldA);
BLAS(cgemm)("N", "T", &n_rest, &n2, &n1, MONE, A_BL_B, ldA, Work_BL, ldWork, ONE, A_BR_B, ldA); BLAS(cgemm)("N", "T", &n_rest, &n2, &n1, MONE, A_BL_B, ldA, Work_BL, ldWork, ONE, A_BR_B, ldA);
// recursion(A_BR) // recursion(A_BR)
int n2_out; blasint n2_out;
RELAPACK_chetrf_rec(uplo, &n_full2, &n2, &n2_out, A_BR, ldA, ipiv_B, Work_BR, &ldWork_BR, &info2); RELAPACK_chetrf_rec(uplo, &n_full2, &n2, &n2_out, A_BR, ldA, ipiv_B, Work_BR, &ldWork_BR, &info2);
if (n2_out != n2) { if (n2_out != n2) {
// undo 1 column of updates // undo 1 column of updates
const int n_restp1 = n_rest + 1; const blasint n_restp1 = n_rest + 1;
// last column of A_BR // last column of A_BR
float *const A_BR_r = A_BR + 2 * *ldA * n2_out + 2 * n2_out; float *const A_BR_r = A_BR + 2 * *ldA * n2_out + 2 * n2_out;
@ -169,7 +169,7 @@ static void RELAPACK_chetrf_rec(
n2 = n2_out; n2 = n2_out;
// shift pivots // shift pivots
int i; blasint i;
for (i = 0; i < n2; i++) for (i = 0; i < n2; i++)
if (ipiv_B[i] > 0) if (ipiv_B[i] > 0)
ipiv_B[i] += n1; ipiv_B[i] += n1;
@ -180,22 +180,22 @@ static void RELAPACK_chetrf_rec(
*n_out = n1 + n2; *n_out = n1 + n2;
} else { } else {
// Splitting (setup) // Splitting (setup)
int n2 = CREC_SPLIT(*n); blasint n2 = CREC_SPLIT(*n);
int n1 = *n - n2; blasint n1 = *n - n2;
// * Work_R // * Work_R
// (top recursion level: use Work as Work_R) // (top recursion level: use Work as Work_R)
float *const Work_R = top ? Work : Work + 2 * *ldWork * n1; float *const Work_R = top ? Work : Work + 2 * *ldWork * n1;
// recursion(A_R) // recursion(A_R)
int n2_out; blasint n2_out;
RELAPACK_chetrf_rec(uplo, n_full, &n2, &n2_out, A, ldA, ipiv, Work_R, ldWork, &info2); RELAPACK_chetrf_rec(uplo, n_full, &n2, &n2_out, A, ldA, ipiv, Work_R, ldWork, &info2);
const int n2_diff = n2 - n2_out; const blasint n2_diff = n2 - n2_out;
n2 = n2_out; n2 = n2_out;
// Splitting (continued) // Splitting (continued)
n1 = *n - n2; n1 = *n - n2;
const int n_full1 = *n_full - n2; const blasint n_full1 = *n_full - n2;
// * A_TL_T A_TR_T // * A_TL_T A_TR_T
// * A_TL A_TR // * A_TL A_TR
@ -211,19 +211,19 @@ static void RELAPACK_chetrf_rec(
// (top recursion level: Work_R was Work) // (top recursion level: Work_R was Work)
float *const Work_L = Work; float *const Work_L = Work;
float *const Work_TR = Work + 2 * *ldWork * (top ? n2_diff : n1) + 2 * n_rest; float *const Work_TR = Work + 2 * *ldWork * (top ? n2_diff : n1) + 2 * n_rest;
const int ldWork_L = top ? n1 : *ldWork; const blasint ldWork_L = top ? n1 : *ldWork;
// A_TL = A_TL - A_TR Work_TR' // A_TL = A_TL - A_TR Work_TR'
RELAPACK_cgemmt(uplo, "N", "T", &n1, &n2, MONE, A_TR, ldA, Work_TR, ldWork, ONE, A_TL, ldA); RELAPACK_cgemmt(uplo, "N", "T", &n1, &n2, MONE, A_TR, ldA, Work_TR, ldWork, ONE, A_TL, ldA);
BLAS(cgemm)("N", "T", &n_rest, &n1, &n2, MONE, A_TR_T, ldA, Work_TR, ldWork, ONE, A_TL_T, ldA); BLAS(cgemm)("N", "T", &n_rest, &n1, &n2, MONE, A_TR_T, ldA, Work_TR, ldWork, ONE, A_TL_T, ldA);
// recursion(A_TL) // recursion(A_TL)
int n1_out; blasint n1_out;
RELAPACK_chetrf_rec(uplo, &n_full1, &n1, &n1_out, A, ldA, ipiv, Work_L, &ldWork_L, &info1); RELAPACK_chetrf_rec(uplo, &n_full1, &n1, &n1_out, A, ldA, ipiv, Work_L, &ldWork_L, &info1);
if (n1_out != n1) { if (n1_out != n1) {
// undo 1 column of updates // undo 1 column of updates
const int n_restp1 = n_rest + 1; const blasint n_restp1 = n_rest + 1;
// A_TL_T_l = A_TL_T_l + A_TR_T Work_TR_t' // A_TL_T_l = A_TL_T_l + A_TR_T Work_TR_t'
BLAS(cgemv)("N", &n_restp1, &n2, ONE, A_TR_T, ldA, Work_TR, ldWork, ONE, A_TL_T, iONE); BLAS(cgemv)("N", &n_restp1, &n2, ONE, A_TR_T, ldA, Work_TR, ldWork, ONE, A_TL_T, iONE);

32
relapack/src/chetrf_rec2.c
View File

@ -15,7 +15,7 @@
/* Table of constant values */ /* Table of constant values */
static complex c_b1 = {1.f,0.f}; static complex c_b1 = {1.f,0.f};
static int c__1 = 1; static blasint c__1 = 1;
/** CHETRF_REC2 computes a partial factorization of a complex Hermitian indefinite matrix using the Bunch-Kau fman diagonal pivoting method /** CHETRF_REC2 computes a partial factorization of a complex Hermitian indefinite matrix using the Bunch-Kau fman diagonal pivoting method
* *
@ -24,12 +24,12 @@ static int c__1 = 1;
* The blocked BLAS Level 3 updates were removed and moved to the * The blocked BLAS Level 3 updates were removed and moved to the
* recursive algorithm. * recursive algorithm.
* */ * */
/* Subroutine */ void RELAPACK_chetrf_rec2(char *uplo, int *n, int * /* Subroutine */ void RELAPACK_chetrf_rec2(char *uplo, blasint *n, blasint *
nb, int *kb, complex *a, int *lda, int *ipiv, complex *w, nb, blasint *kb, complex *a, blasint *lda, blasint *ipiv, complex *w,
int *ldw, int *info, ftnlen uplo_len) int *ldw, blasint *info, ftnlen uplo_len)
{ {
/* System generated locals */ /* System generated locals */
int a_dim1, a_offset, w_dim1, w_offset, i__1, i__2, i__3, i__4; blasint a_dim1, a_offset, w_dim1, w_offset, i__1, i__2, i__3, i__4;
float r__1, r__2, r__3, r__4; float r__1, r__2, r__3, r__4;
complex q__1, q__2, q__3, q__4; complex q__1, q__2, q__3, q__4;
@ -38,22 +38,22 @@ static int c__1 = 1;
void r_cnjg(complex *, complex *), c_div(complex *, complex *, complex *); void r_cnjg(complex *, complex *), c_div(complex *, complex *, complex *);
/* Local variables */ /* Local variables */
static int j, k; static blasint j, k;
static float t, r1; static float t, r1;
static complex d11, d21, d22; static complex d11, d21, d22;
static int jj, kk, jp, kp, kw, kkw, imax, jmax; static blasint jj, kk, jp, kp, kw, kkw, imax, jmax;
static float alpha; static float alpha;
extern logical lsame_(char *, char *, ftnlen, ftnlen); extern logical lsame_(char *, char *, ftnlen, ftnlen);
extern /* Subroutine */ int cgemv_(char *, int *, int *, complex * extern /* Subroutine */ blasint cgemv_(char *, blasint *, blasint *, complex *
, complex *, int *, complex *, int *, complex *, complex * , complex *, blasint *, complex *, blasint *, complex *, complex *
, int *, ftnlen), ccopy_(int *, complex *, int *, , blasint *, ftnlen), ccopy_(int *, complex *, blasint *,
complex *, int *), cswap_(int *, complex *, int *, complex *, blasint *), cswap_(int *, complex *, blasint *,
complex *, int *); complex *, blasint *);
static int kstep; static blasint kstep;
static float absakk; static float absakk;
extern /* Subroutine */ int clacgv_(int *, complex *, int *); extern /* Subroutine */ blasint clacgv_(int *, complex *, blasint *);
extern int icamax_(int *, complex *, int *); extern blasint icamax_(int *, complex *, blasint *);
extern /* Subroutine */ int csscal_(int *, float *, complex *, int extern /* Subroutine */ blasint csscal_(int *, float *, complex *, int
*); *);
static float colmax, rowmax; static float colmax, rowmax;

72
relapack/src/chetrf_rook.c
View File

@ -3,8 +3,8 @@
#include <stdlib.h> #include <stdlib.h>
#endif #endif
static void RELAPACK_chetrf_rook_rec(const char *, const int *, const int *, int *, static void RELAPACK_chetrf_rook_rec(const char *, const blasint *, const blasint *, blasint *,
float *, const int *, int *, float *, const int *, int *); float *, const blasint *, blasint *, float *, const blasint *, blasint *);
/** CHETRF_ROOK computes the factorization of a complex Hermitian indefinite matrix using the bounded Bunch-Kaufman ("rook") diagonal pivoting method. /** CHETRF_ROOK computes the factorization of a complex Hermitian indefinite matrix using the bounded Bunch-Kaufman ("rook") diagonal pivoting method.
@ -14,21 +14,21 @@ static void RELAPACK_chetrf_rook_rec(const char *, const int *, const int *, int
* http://www.netlib.org/lapack/explore-html/d0/d5e/chetrf__rook_8f.html * http://www.netlib.org/lapack/explore-html/d0/d5e/chetrf__rook_8f.html
* */ * */
void RELAPACK_chetrf_rook( void RELAPACK_chetrf_rook(
const char *uplo, const int *n, const char *uplo, const blasint *n,
float *A, const int *ldA, int *ipiv, float *A, const blasint *ldA, blasint *ipiv,
float *Work, const int *lWork, int *info float *Work, const blasint *lWork, blasint *info
) { ) {
// Required work size // Required work size
const int cleanlWork = *n * (*n / 2); const blasint cleanlWork = *n * (*n / 2);
int minlWork = cleanlWork; blasint minlWork = cleanlWork;
#if XSYTRF_ALLOW_MALLOC #if XSYTRF_ALLOW_MALLOC
minlWork = 1; minlWork = 1;
#endif #endif
// Check arguments // Check arguments
const int lower = LAPACK(lsame)(uplo, "L"); const blasint lower = LAPACK(lsame)(uplo, "L");
const int upper = LAPACK(lsame)(uplo, "U"); const blasint upper = LAPACK(lsame)(uplo, "U");
*info = 0; *info = 0;
if (!lower && !upper) if (!lower && !upper)
*info = -1; *info = -1;
@ -55,8 +55,8 @@ void RELAPACK_chetrf_rook(
#endif #endif
if (*info) { if (*info) {
const int minfo = -*info; const blasint minfo = -*info;
LAPACK(xerbla)("CHETRF", &minfo); LAPACK(xerbla)("CHETRF", &minfo, strlen("CHETRF"));
return; return;
} }
@ -64,7 +64,7 @@ void RELAPACK_chetrf_rook(
const char cleanuplo = lower ? 'L' : 'U'; const char cleanuplo = lower ? 'L' : 'U';
// Dummy argument // Dummy argument
int nout; blasint nout;
// Recursive kernel // Recursive kernel
RELAPACK_chetrf_rook_rec(&cleanuplo, n, n, &nout, A, ldA, ipiv, cleanWork, n, info); RELAPACK_chetrf_rook_rec(&cleanuplo, n, n, &nout, A, ldA, ipiv, cleanWork, n, info);
@ -78,13 +78,13 @@ void RELAPACK_chetrf_rook(
/** chetrf_rook's recursive compute kernel */ /** chetrf_rook's recursive compute kernel */
static void RELAPACK_chetrf_rook_rec( static void RELAPACK_chetrf_rook_rec(
const char *uplo, const int *n_full, const int *n, int *n_out, const char *uplo, const blasint *n_full, const blasint *n, blasint *n_out,
float *A, const int *ldA, int *ipiv, float *A, const blasint *ldA, blasint *ipiv,
float *Work, const int *ldWork, int *info float *Work, const blasint *ldWork, blasint *info
) { ) {
// top recursion level? // top recursion level?
const int top = *n_full == *n; const blasint top = *n_full == *n;
if (*n <= MAX(CROSSOVER_CHETRF, 3)) { if (*n <= MAX(CROSSOVER_CHETRF, 3)) {
// Unblocked // Unblocked
@ -96,31 +96,31 @@ static void RELAPACK_chetrf_rook_rec(
return; return;
} }
int info1, info2; blasint info1, info2;
// Constants // Constants
const float ONE[] = { 1., 0. }; const float ONE[] = { 1., 0. };
const float MONE[] = { -1., 0. }; const float MONE[] = { -1., 0. };
const int iONE[] = { 1 }; const blasint iONE[] = { 1 };
const int n_rest = *n_full - *n; const blasint n_rest = *n_full - *n;
if (*uplo == 'L') { if (*uplo == 'L') {
// Splitting (setup) // Splitting (setup)
int n1 = CREC_SPLIT(*n); blasint n1 = CREC_SPLIT(*n);
int n2 = *n - n1; blasint n2 = *n - n1;
// Work_L * // Work_L *
float *const Work_L = Work; float *const Work_L = Work;
// recursion(A_L) // recursion(A_L)
int n1_out; blasint n1_out;
RELAPACK_chetrf_rook_rec(uplo, n_full, &n1, &n1_out, A, ldA, ipiv, Work_L, ldWork, &info1); RELAPACK_chetrf_rook_rec(uplo, n_full, &n1, &n1_out, A, ldA, ipiv, Work_L, ldWork, &info1);
n1 = n1_out; n1 = n1_out;
// Splitting (continued) // Splitting (continued)
n2 = *n - n1; n2 = *n - n1;
const int n_full2 = *n_full - n1; const blasint n_full2 = *n_full - n1;
// * * // * *
// A_BL A_BR // A_BL A_BR
@ -136,23 +136,23 @@ static void RELAPACK_chetrf_rook_rec(
// (top recursion level: use Work as Work_BR) // (top recursion level: use Work as Work_BR)
float *const Work_BL = Work + 2 * n1; float *const Work_BL = Work + 2 * n1;
float *const Work_BR = top ? Work : Work + 2 * *ldWork * n1 + 2 * n1; float *const Work_BR = top ? Work : Work + 2 * *ldWork * n1 + 2 * n1;
const int ldWork_BR = top ? n2 : *ldWork; const blasint ldWork_BR = top ? n2 : *ldWork;
// ipiv_T // ipiv_T
// ipiv_B // ipiv_B
int *const ipiv_B = ipiv + n1; blasint *const ipiv_B = ipiv + n1;
// A_BR = A_BR - A_BL Work_BL' // A_BR = A_BR - A_BL Work_BL'
RELAPACK_cgemmt(uplo, "N", "T", &n2, &n1, MONE, A_BL, ldA, Work_BL, ldWork, ONE, A_BR, ldA); RELAPACK_cgemmt(uplo, "N", "T", &n2, &n1, MONE, A_BL, ldA, Work_BL, ldWork, ONE, A_BR, ldA);
BLAS(cgemm)("N", "T", &n_rest, &n2, &n1, MONE, A_BL_B, ldA, Work_BL, ldWork, ONE, A_BR_B, ldA); BLAS(cgemm)("N", "T", &n_rest, &n2, &n1, MONE, A_BL_B, ldA, Work_BL, ldWork, ONE, A_BR_B, ldA);
// recursion(A_BR) // recursion(A_BR)
int n2_out; blasint n2_out;
RELAPACK_chetrf_rook_rec(uplo, &n_full2, &n2, &n2_out, A_BR, ldA, ipiv_B, Work_BR, &ldWork_BR, &info2); RELAPACK_chetrf_rook_rec(uplo, &n_full2, &n2, &n2_out, A_BR, ldA, ipiv_B, Work_BR, &ldWork_BR, &info2);
if (n2_out != n2) { if (n2_out != n2) {
// undo 1 column of updates // undo 1 column of updates
const int n_restp1 = n_rest + 1; const blasint n_restp1 = n_rest + 1;
// last column of A_BR // last column of A_BR
float *const A_BR_r = A_BR + 2 * *ldA * n2_out + 2 * n2_out; float *const A_BR_r = A_BR + 2 * *ldA * n2_out + 2 * n2_out;
@ -169,7 +169,7 @@ static void RELAPACK_chetrf_rook_rec(
n2 = n2_out; n2 = n2_out;
// shift pivots // shift pivots
int i; blasint i;
for (i = 0; i < n2; i++) for (i = 0; i < n2; i++)
if (ipiv_B[i] > 0) if (ipiv_B[i] > 0)
ipiv_B[i] += n1; ipiv_B[i] += n1;
@ -180,22 +180,22 @@ static void RELAPACK_chetrf_rook_rec(
*n_out = n1 + n2; *n_out = n1 + n2;
} else { } else {
// Splitting (setup) // Splitting (setup)
int n2 = CREC_SPLIT(*n); blasint n2 = CREC_SPLIT(*n);
int n1 = *n - n2; blasint n1 = *n - n2;
// * Work_R // * Work_R
// (top recursion level: use Work as Work_R) // (top recursion level: use Work as Work_R)
float *const Work_R = top ? Work : Work + 2 * *ldWork * n1; float *const Work_R = top ? Work : Work + 2 * *ldWork * n1;
// recursion(A_R) // recursion(A_R)
int n2_out; blasint n2_out;
RELAPACK_chetrf_rook_rec(uplo, n_full, &n2, &n2_out, A, ldA, ipiv, Work_R, ldWork, &info2); RELAPACK_chetrf_rook_rec(uplo, n_full, &n2, &n2_out, A, ldA, ipiv, Work_R, ldWork, &info2);
const int n2_diff = n2 - n2_out; const blasint n2_diff = n2 - n2_out;
n2 = n2_out; n2 = n2_out;
// Splitting (continued) // Splitting (continued)
n1 = *n - n2; n1 = *n - n2;
const int n_full1 = *n_full - n2; const blasint n_full1 = *n_full - n2;
// * A_TL_T A_TR_T // * A_TL_T A_TR_T
// * A_TL A_TR // * A_TL A_TR
@ -211,19 +211,19 @@ static void RELAPACK_chetrf_rook_rec(
// (top recursion level: Work_R was Work) // (top recursion level: Work_R was Work)
float *const Work_L = Work; float *const Work_L = Work;
float *const Work_TR = Work + 2 * *ldWork * (top ? n2_diff : n1) + 2 * n_rest; float *const Work_TR = Work + 2 * *ldWork * (top ? n2_diff : n1) + 2 * n_rest;
const int ldWork_L = top ? n1 : *ldWork; const blasint ldWork_L = top ? n1 : *ldWork;
// A_TL = A_TL - A_TR Work_TR' // A_TL = A_TL - A_TR Work_TR'
RELAPACK_cgemmt(uplo, "N", "T", &n1, &n2, MONE, A_TR, ldA, Work_TR, ldWork, ONE, A_TL, ldA); RELAPACK_cgemmt(uplo, "N", "T", &n1, &n2, MONE, A_TR, ldA, Work_TR, ldWork, ONE, A_TL, ldA);
BLAS(cgemm)("N", "T", &n_rest, &n1, &n2, MONE, A_TR_T, ldA, Work_TR, ldWork, ONE, A_TL_T, ldA); BLAS(cgemm)("N", "T", &n_rest, &n1, &n2, MONE, A_TR_T, ldA, Work_TR, ldWork, ONE, A_TL_T, ldA);
// recursion(A_TL) // recursion(A_TL)
int n1_out; blasint n1_out;
RELAPACK_chetrf_rook_rec(uplo, &n_full1, &n1, &n1_out, A, ldA, ipiv, Work_L, &ldWork_L, &info1); RELAPACK_chetrf_rook_rec(uplo, &n_full1, &n1, &n1_out, A, ldA, ipiv, Work_L, &ldWork_L, &info1);
if (n1_out != n1) { if (n1_out != n1) {
// undo 1 column of updates // undo 1 column of updates
const int n_restp1 = n_rest + 1; const blasint n_restp1 = n_rest + 1;
// A_TL_T_l = A_TL_T_l + A_TR_T Work_TR_t' // A_TL_T_l = A_TL_T_l + A_TR_T Work_TR_t'
BLAS(cgemv)("N", &n_restp1, &n2, ONE, A_TR_T, ldA, Work_TR, ldWork, ONE, A_TL_T, iONE); BLAS(cgemv)("N", &n_restp1, &n2, ONE, A_TR_T, ldA, Work_TR, ldWork, ONE, A_TL_T, iONE);

40
relapack/src/chetrf_rook_rec2.c
View File

@ -15,7 +15,7 @@
/* Table of constant values */ /* Table of constant values */
static complex c_b1 = {1.f,0.f}; static complex c_b1 = {1.f,0.f};
static int c__1 = 1; static blasint c__1 = 1;
/** CHETRF_ROOK_REC2 computes a partial factorization of a complex Hermitian indefinite matrix using the boun ded Bunch-Kaufman ("rook") diagonal pivoting method /** CHETRF_ROOK_REC2 computes a partial factorization of a complex Hermitian indefinite matrix using the boun ded Bunch-Kaufman ("rook") diagonal pivoting method
* *
@ -24,12 +24,12 @@ static int c__1 = 1;
* The blocked BLAS Level 3 updates were removed and moved to the * The blocked BLAS Level 3 updates were removed and moved to the
* recursive algorithm. * recursive algorithm.
* */ * */
/* Subroutine */ void RELAPACK_chetrf_rook_rec2(char *uplo, int *n, /* Subroutine */ void RELAPACK_chetrf_rook_rec2(char *uplo, blasint *n,
int *nb, int *kb, complex *a, int *lda, int *ipiv, int *nb, blasint *kb, complex *a, blasint *lda, blasint *ipiv,
complex *w, int *ldw, int *info, ftnlen uplo_len) complex *w, blasint *ldw, blasint *info, ftnlen uplo_len)
{ {
/* System generated locals */ /* System generated locals */
int a_dim1, a_offset, w_dim1, w_offset, i__1, i__2, i__3, i__4; blasint a_dim1, a_offset, w_dim1, w_offset, i__1, i__2, i__3, i__4;
float r__1, r__2; float r__1, r__2;
complex q__1, q__2, q__3, q__4, q__5; complex q__1, q__2, q__3, q__4, q__5;
@ -38,29 +38,29 @@ static int c__1 = 1;
void r_cnjg(complex *, complex *), c_div(complex *, complex *, complex *); void r_cnjg(complex *, complex *), c_div(complex *, complex *, complex *);
/* Local variables */ /* Local variables */
static int j, k, p; static blasint j, k, p;
static float t, r1; static float t, r1;
static complex d11, d21, d22; static complex d11, d21, d22;
static int ii, jj, kk, kp, kw, jp1, jp2, kkw; static blasint ii, jj, kk, kp, kw, jp1, jp2, kkw;
static logical done; static logical done;
static int imax, jmax; static blasint imax, jmax;
static float alpha; static float alpha;
extern logical lsame_(char *, char *, ftnlen, ftnlen); extern logical lsame_(char *, char *, ftnlen, ftnlen);
extern /* Subroutine */ int cgemv_(char *, int *, int *, complex * extern /* Subroutine */ blasint cgemv_(char *, blasint *, blasint *, complex *
, complex *, int *, complex *, int *, complex *, complex * , complex *, blasint *, complex *, blasint *, complex *, complex *
, int *, ftnlen); , blasint *, ftnlen);
static float sfmin; static float sfmin;
extern /* Subroutine */ int ccopy_(int *, complex *, int *, extern /* Subroutine */ blasint ccopy_(int *, complex *, blasint *,
complex *, int *); complex *, blasint *);
static int itemp; static blasint itemp;
extern /* Subroutine */ int cswap_(int *, complex *, int *, extern /* Subroutine */ blasint cswap_(int *, complex *, blasint *,
complex *, int *); complex *, blasint *);
static int kstep; static blasint kstep;
static float stemp, absakk; static float stemp, absakk;
extern /* Subroutine */ int clacgv_(int *, complex *, int *); extern /* Subroutine */ blasint clacgv_(int *, complex *, blasint *);
extern int icamax_(int *, complex *, int *); extern blasint icamax_(int *, complex *, blasint *);
extern double slamch_(char *, ftnlen); extern double slamch_(char *, ftnlen);
extern /* Subroutine */ int csscal_(int *, float *, complex *, int extern /* Subroutine */ blasint csscal_(int *, float *, complex *, int
*); *);
static float colmax, rowmax; static float colmax, rowmax;

28
relapack/src/clauum.c
View File

@ -1,7 +1,7 @@
#include "relapack.h" #include "relapack.h"
static void RELAPACK_clauum_rec(const char *, const int *, float *, static void RELAPACK_clauum_rec(const char *, const blasint *, float *,
const int *, int *); const blasint *, blasint *);
/** CLAUUM computes the product U * U**H or L**H * L, where the triangular factor U or L is stored in the upper or lower triangular part of the array A. /** CLAUUM computes the product U * U**H or L**H * L, where the triangular factor U or L is stored in the upper or lower triangular part of the array A.
@ -11,14 +11,14 @@ static void RELAPACK_clauum_rec(const char *, const int *, float *,
* http://www.netlib.org/lapack/explore-html/d2/d36/clauum_8f.html * http://www.netlib.org/lapack/explore-html/d2/d36/clauum_8f.html
* */ * */
void RELAPACK_clauum( void RELAPACK_clauum(
const char *uplo, const int *n, const char *uplo, const blasint *n,
float *A, const int *ldA, float *A, const blasint *ldA,
int *info blasint *info
) { ) {
// Check arguments // Check arguments
const int lower = LAPACK(lsame)(uplo, "L"); const blasint lower = LAPACK(lsame)(uplo, "L");
const int upper = LAPACK(lsame)(uplo, "U"); const blasint upper = LAPACK(lsame)(uplo, "U");
*info = 0; *info = 0;
if (!lower && !upper) if (!lower && !upper)
*info = -1; *info = -1;
@ -27,8 +27,8 @@ void RELAPACK_clauum(
else if (*ldA < MAX(1, *n)) else if (*ldA < MAX(1, *n))
*info = -4; *info = -4;
if (*info) { if (*info) {
const int minfo = -*info; const blasint minfo = -*info;
LAPACK(xerbla)("CLAUUM", &minfo); LAPACK(xerbla)("CLAUUM", &minfo, strlen("CLAUUM"));
return; return;
} }
@ -42,9 +42,9 @@ void RELAPACK_clauum(
/** clauum's recursive compute kernel */ /** clauum's recursive compute kernel */
static void RELAPACK_clauum_rec( static void RELAPACK_clauum_rec(
const char *uplo, const int *n, const char *uplo, const blasint *n,
float *A, const int *ldA, float *A, const blasint *ldA,
int *info blasint *info
) { ) {
if (*n <= MAX(CROSSOVER_CLAUUM, 1)) { if (*n <= MAX(CROSSOVER_CLAUUM, 1)) {
@ -57,8 +57,8 @@ static void RELAPACK_clauum_rec(
const float ONE[] = { 1., 0. }; const float ONE[] = { 1., 0. };
// Splitting // Splitting
const int n1 = CREC_SPLIT(*n); const blasint n1 = CREC_SPLIT(*n);
const int n2 = *n - n1; const blasint n2 = *n - n1;
// A_TL A_TR // A_TL A_TR
// A_BL A_BR // A_BL A_BR

42
relapack/src/cpbtrf.c
View File

@ -1,8 +1,8 @@
#include "relapack.h" #include "relapack.h"
#include "stdlib.h" #include "stdlib.h"
static void RELAPACK_cpbtrf_rec(const char *, const int *, const int *, static void RELAPACK_cpbtrf_rec(const char *, const blasint *, const blasint *,
float *, const int *, float *, const int *, int *); float *, const blasint *, float *, const blasint *, blasint *);
/** CPBTRF computes the Cholesky factorization of a complex Hermitian positive definite band matrix A. /** CPBTRF computes the Cholesky factorization of a complex Hermitian positive definite band matrix A.
@ -12,14 +12,14 @@ static void RELAPACK_cpbtrf_rec(const char *, const int *, const int *,
* http://www.netlib.org/lapack/explore-html/de/d2d/cpbtrf_8f.html * http://www.netlib.org/lapack/explore-html/de/d2d/cpbtrf_8f.html
* */ * */
void RELAPACK_cpbtrf( void RELAPACK_cpbtrf(
const char *uplo, const int *n, const int *kd, const char *uplo, const blasint *n, const blasint *kd,
float *Ab, const int *ldAb, float *Ab, const blasint *ldAb,
int *info blasint *info
) { ) {
// Check arguments // Check arguments
const int lower = LAPACK(lsame)(uplo, "L"); const blasint lower = LAPACK(lsame)(uplo, "L");
const int upper = LAPACK(lsame)(uplo, "U"); const blasint upper = LAPACK(lsame)(uplo, "U");
*info = 0; *info = 0;
if (!lower && !upper) if (!lower && !upper)
*info = -1; *info = -1;
@ -30,8 +30,8 @@ void RELAPACK_cpbtrf(
else if (*ldAb < *kd + 1) else if (*ldAb < *kd + 1)
*info = -5; *info = -5;
if (*info) { if (*info) {
const int minfo = -*info; const blasint minfo = -*info;
LAPACK(xerbla)("CPBTRF", &minfo); LAPACK(xerbla)("CPBTRF", &minfo, strlen("CPBTRF"));
return; return;
} }
@ -42,9 +42,9 @@ void RELAPACK_cpbtrf(
const float ZERO[] = { 0., 0. }; const float ZERO[] = { 0., 0. };
// Allocate work space // Allocate work space
const int n1 = CREC_SPLIT(*n); const blasint n1 = CREC_SPLIT(*n);
const int mWork = (*kd > n1) ? (lower ? *n - *kd : n1) : *kd; const blasint mWork = (*kd > n1) ? (lower ? *n - *kd : n1) : *kd;
const int nWork = (*kd > n1) ? (lower ? n1 : *n - *kd) : *kd; const blasint nWork = (*kd > n1) ? (lower ? n1 : *n - *kd) : *kd;
float *Work = malloc(mWork * nWork * 2 * sizeof(float)); float *Work = malloc(mWork * nWork * 2 * sizeof(float));
LAPACK(claset)(uplo, &mWork, &nWork, ZERO, ZERO, Work, &mWork); LAPACK(claset)(uplo, &mWork, &nWork, ZERO, ZERO, Work, &mWork);
@ -58,10 +58,10 @@ void RELAPACK_cpbtrf(
/** cpbtrf's recursive compute kernel */ /** cpbtrf's recursive compute kernel */
static void RELAPACK_cpbtrf_rec( static void RELAPACK_cpbtrf_rec(
const char *uplo, const int *n, const int *kd, const char *uplo, const blasint *n, const blasint *kd,
float *Ab, const int *ldAb, float *Ab, const blasint *ldAb,
float *Work, const int *ldWork, float *Work, const blasint *ldWork,
int *info blasint *info
){ ){
if (*n <= MAX(CROSSOVER_CPBTRF, 1)) { if (*n <= MAX(CROSSOVER_CPBTRF, 1)) {
@ -75,12 +75,12 @@ static void RELAPACK_cpbtrf_rec(
const float MONE[] = { -1., 0. }; const float MONE[] = { -1., 0. };
// Unskew A // Unskew A
const int ldA[] = { *ldAb - 1 }; const blasint ldA[] = { *ldAb - 1 };
float *const A = Ab + 2 * ((*uplo == 'L') ? 0 : *kd); float *const A = Ab + 2 * ((*uplo == 'L') ? 0 : *kd);
// Splitting // Splitting
const int n1 = MIN(CREC_SPLIT(*n), *kd); const blasint n1 = MIN(CREC_SPLIT(*n), *kd);
const int n2 = *n - n1; const blasint n2 = *n - n1;
// * * // * *
// * Ab_BR // * Ab_BR
@ -99,8 +99,8 @@ static void RELAPACK_cpbtrf_rec(
return; return;
// Banded splitting // Banded splitting
const int n21 = MIN(n2, *kd - n1); const blasint n21 = MIN(n2, *kd - n1);
const int n22 = MIN(n2 - n21, *kd); const blasint n22 = MIN(n2 - n21, *kd);
// n1 n21 n22 // n1 n21 n22
// n1 * A_TRl A_TRr // n1 * A_TRl A_TRr

28
relapack/src/cpotrf.c
View File

@ -1,7 +1,7 @@
#include "relapack.h" #include "relapack.h"
static void RELAPACK_cpotrf_rec(const char *, const int *, float *, static void RELAPACK_cpotrf_rec(const char *, const blasint *, float *,
const int *, int *); const blasint *, blasint *);
/** CPOTRF computes the Cholesky factorization of a complex Hermitian positive definite matrix A. /** CPOTRF computes the Cholesky factorization of a complex Hermitian positive definite matrix A.
@ -11,14 +11,14 @@ static void RELAPACK_cpotrf_rec(const char *, const int *, float *,
* http://www.netlib.org/lapack/explore-html/dd/dce/cpotrf_8f.html * http://www.netlib.org/lapack/explore-html/dd/dce/cpotrf_8f.html
* */ * */
void RELAPACK_cpotrf( void RELAPACK_cpotrf(
const char *uplo, const int *n, const char *uplo, const blasint *n,
float *A, const int *ldA, float *A, const blasint *ldA,
int *info blasint *info
) { ) {
// Check arguments // Check arguments
const int lower = LAPACK(lsame)(uplo, "L"); const blasint lower = LAPACK(lsame)(uplo, "L");
const int upper = LAPACK(lsame)(uplo, "U"); const blasint upper = LAPACK(lsame)(uplo, "U");
*info = 0; *info = 0;
if (!lower && !upper) if (!lower && !upper)
*info = -1; *info = -1;
@ -27,8 +27,8 @@ void RELAPACK_cpotrf(
else if (*ldA < MAX(1, *n)) else if (*ldA < MAX(1, *n))
*info = -4; *info = -4;
if (*info) { if (*info) {
const int minfo = -*info; const blasint minfo = -*info;
LAPACK(xerbla)("CPOTRF", &minfo); LAPACK(xerbla)("CPOTRF", &minfo, strlen("CPOTRF"));
return; return;
} }
@ -42,9 +42,9 @@ void RELAPACK_cpotrf(
/** cpotrf's recursive compute kernel */ /** cpotrf's recursive compute kernel */
static void RELAPACK_cpotrf_rec( static void RELAPACK_cpotrf_rec(
const char *uplo, const int *n, const char *uplo, const blasint *n,
float *A, const int *ldA, float *A, const blasint *ldA,
int *info blasint *info
){ ){
if (*n <= MAX(CROSSOVER_CPOTRF, 1)) { if (*n <= MAX(CROSSOVER_CPOTRF, 1)) {
@ -58,8 +58,8 @@ static void RELAPACK_cpotrf_rec(
const float MONE[] = { -1., 0. }; const float MONE[] = { -1., 0. };
// Splitting // Splitting
const int n1 = CREC_SPLIT(*n); const blasint n1 = CREC_SPLIT(*n);
const int n2 = *n - n1; const blasint n2 = *n - n1;
// A_TL A_TR // A_TL A_TR
// A_BL A_BR // A_BL A_BR

72
relapack/src/csytrf.c
View File

@ -3,8 +3,8 @@
#include <stdlib.h> #include <stdlib.h>
#endif #endif
static void RELAPACK_csytrf_rec(const char *, const int *, const int *, int *, static void RELAPACK_csytrf_rec(const char *, const blasint *, const blasint *, blasint *,
float *, const int *, int *, float *, const int *, int *); float *, const blasint *, blasint *, float *, const blasint *, blasint *);
/** CSYTRF computes the factorization of a complex symmetric matrix A using the Bunch-Kaufman diagonal pivoting method. /** CSYTRF computes the factorization of a complex symmetric matrix A using the Bunch-Kaufman diagonal pivoting method.
@ -14,21 +14,21 @@ static void RELAPACK_csytrf_rec(const char *, const int *, const int *, int *,
* http://www.netlib.org/lapack/explore-html/d5/d21/csytrf_8f.html * http://www.netlib.org/lapack/explore-html/d5/d21/csytrf_8f.html
* */ * */
void RELAPACK_csytrf( void RELAPACK_csytrf(
const char *uplo, const int *n, const char *uplo, const blasint *n,
float *A, const int *ldA, int *ipiv, float *A, const blasint *ldA, blasint *ipiv,
float *Work, const int *lWork, int *info float *Work, const blasint *lWork, blasint *info
) { ) {
// Required work size // Required work size
const int cleanlWork = *n * (*n / 2); const blasint cleanlWork = *n * (*n / 2);
int minlWork = cleanlWork; blasint minlWork = cleanlWork;
#if XSYTRF_ALLOW_MALLOC #if XSYTRF_ALLOW_MALLOC
minlWork = 1; minlWork = 1;
#endif #endif
// Check arguments // Check arguments
const int lower = LAPACK(lsame)(uplo, "L"); const blasint lower = LAPACK(lsame)(uplo, "L");
const int upper = LAPACK(lsame)(uplo, "U"); const blasint upper = LAPACK(lsame)(uplo, "U");
*info = 0; *info = 0;
if (!lower && !upper) if (!lower && !upper)
*info = -1; *info = -1;
@ -55,8 +55,8 @@ void RELAPACK_csytrf(
#endif #endif
if (*info) { if (*info) {
const int minfo = -*info; const blasint minfo = -*info;
LAPACK(xerbla)("CSYTRF", &minfo); LAPACK(xerbla)("CSYTRF", &minfo, strlen("CSYTRF"));
return; return;
} }
@ -64,7 +64,7 @@ void RELAPACK_csytrf(
const char cleanuplo = lower ? 'L' : 'U'; const char cleanuplo = lower ? 'L' : 'U';
// Dummy arguments // Dummy arguments
int nout; blasint nout;
// Recursive kernel // Recursive kernel
RELAPACK_csytrf_rec(&cleanuplo, n, n, &nout, A, ldA, ipiv, cleanWork, n, info); RELAPACK_csytrf_rec(&cleanuplo, n, n, &nout, A, ldA, ipiv, cleanWork, n, info);
@ -78,13 +78,13 @@ void RELAPACK_csytrf(
/** csytrf's recursive compute kernel */ /** csytrf's recursive compute kernel */
static void RELAPACK_csytrf_rec( static void RELAPACK_csytrf_rec(
const char *uplo, const int *n_full, const int *n, int *n_out, const char *uplo, const blasint *n_full, const blasint *n, blasint *n_out,
float *A, const int *ldA, int *ipiv, float *A, const blasint *ldA, blasint *ipiv,
float *Work, const int *ldWork, int *info float *Work, const blasint *ldWork, blasint *info
) { ) {
// top recursion level? // top recursion level?
const int top = *n_full == *n; const blasint top = *n_full == *n;
if (*n <= MAX(CROSSOVER_CSYTRF, 3)) { if (*n <= MAX(CROSSOVER_CSYTRF, 3)) {
// Unblocked // Unblocked
@ -96,34 +96,34 @@ static void RELAPACK_csytrf_rec(
return; return;
} }
int info1, info2; blasint info1, info2;
// Constants // Constants
const float ONE[] = { 1., 0. }; const float ONE[] = { 1., 0. };
const float MONE[] = { -1., 0. }; const float MONE[] = { -1., 0. };
const int iONE[] = { 1 }; const blasint iONE[] = { 1 };
// Loop iterator // Loop iterator
int i; blasint i;
const int n_rest = *n_full - *n; const blasint n_rest = *n_full - *n;
if (*uplo == 'L') { if (*uplo == 'L') {
// Splitting (setup) // Splitting (setup)
int n1 = CREC_SPLIT(*n); blasint n1 = CREC_SPLIT(*n);
int n2 = *n - n1; blasint n2 = *n - n1;
// Work_L * // Work_L *
float *const Work_L = Work; float *const Work_L = Work;
// recursion(A_L) // recursion(A_L)
int n1_out; blasint n1_out;
RELAPACK_csytrf_rec(uplo, n_full, &n1, &n1_out, A, ldA, ipiv, Work_L, ldWork, &info1); RELAPACK_csytrf_rec(uplo, n_full, &n1, &n1_out, A, ldA, ipiv, Work_L, ldWork, &info1);
n1 = n1_out; n1 = n1_out;
// Splitting (continued) // Splitting (continued)
n2 = *n - n1; n2 = *n - n1;
const int n_full2 = *n_full - n1; const blasint n_full2 = *n_full - n1;
// * * // * *
// A_BL A_BR // A_BL A_BR
@ -139,23 +139,23 @@ static void RELAPACK_csytrf_rec(
// (top recursion level: use Work as Work_BR) // (top recursion level: use Work as Work_BR)
float *const Work_BL = Work + 2 * n1; float *const Work_BL = Work + 2 * n1;
float *const Work_BR = top ? Work : Work + 2 * *ldWork * n1 + 2 * n1; float *const Work_BR = top ? Work : Work + 2 * *ldWork * n1 + 2 * n1;
const int ldWork_BR = top ? n2 : *ldWork; const blasint ldWork_BR = top ? n2 : *ldWork;
// ipiv_T // ipiv_T
// ipiv_B // ipiv_B
int *const ipiv_B = ipiv + n1; blasint *const ipiv_B = ipiv + n1;
// A_BR = A_BR - A_BL Work_BL' // A_BR = A_BR - A_BL Work_BL'
RELAPACK_cgemmt(uplo, "N", "T", &n2, &n1, MONE, A_BL, ldA, Work_BL, ldWork, ONE, A_BR, ldA); RELAPACK_cgemmt(uplo, "N", "T", &n2, &n1, MONE, A_BL, ldA, Work_BL, ldWork, ONE, A_BR, ldA);
BLAS(cgemm)("N", "T", &n_rest, &n2, &n1, MONE, A_BL_B, ldA, Work_BL, ldWork, ONE, A_BR_B, ldA); BLAS(cgemm)("N", "T", &n_rest, &n2, &n1, MONE, A_BL_B, ldA, Work_BL, ldWork, ONE, A_BR_B, ldA);
// recursion(A_BR) // recursion(A_BR)
int n2_out; blasint n2_out;
RELAPACK_csytrf_rec(uplo, &n_full2, &n2, &n2_out, A_BR, ldA, ipiv_B, Work_BR, &ldWork_BR, &info2); RELAPACK_csytrf_rec(uplo, &n_full2, &n2, &n2_out, A_BR, ldA, ipiv_B, Work_BR, &ldWork_BR, &info2);
if (n2_out != n2) { if (n2_out != n2) {
// undo 1 column of updates // undo 1 column of updates
const int n_restp1 = n_rest + 1; const blasint n_restp1 = n_rest + 1;
// last column of A_BR // last column of A_BR
float *const A_BR_r = A_BR + 2 * *ldA * n2_out + 2 * n2_out; float *const A_BR_r = A_BR + 2 * *ldA * n2_out + 2 * n2_out;
@ -182,22 +182,22 @@ static void RELAPACK_csytrf_rec(
*n_out = n1 + n2; *n_out = n1 + n2;
} else { } else {
// Splitting (setup) // Splitting (setup)
int n2 = CREC_SPLIT(*n); blasint n2 = CREC_SPLIT(*n);
int n1 = *n - n2; blasint n1 = *n - n2;
// * Work_R // * Work_R
// (top recursion level: use Work as Work_R) // (top recursion level: use Work as Work_R)
float *const Work_R = top ? Work : Work + 2 * *ldWork * n1; float *const Work_R = top ? Work : Work + 2 * *ldWork * n1;
// recursion(A_R) // recursion(A_R)
int n2_out; blasint n2_out;
RELAPACK_csytrf_rec(uplo, n_full, &n2, &n2_out, A, ldA, ipiv, Work_R, ldWork, &info2); RELAPACK_csytrf_rec(uplo, n_full, &n2, &n2_out, A, ldA, ipiv, Work_R, ldWork, &info2);
const int n2_diff = n2 - n2_out; const blasint n2_diff = n2 - n2_out;
n2 = n2_out; n2 = n2_out;
// Splitting (continued) // Splitting (continued)
n1 = *n - n2; n1 = *n - n2;
const int n_full1 = *n_full - n2; const blasint n_full1 = *n_full - n2;
// * A_TL_T A_TR_T // * A_TL_T A_TR_T
// * A_TL A_TR // * A_TL A_TR
@ -213,19 +213,19 @@ static void RELAPACK_csytrf_rec(
// (top recursion level: Work_R was Work) // (top recursion level: Work_R was Work)
float *const Work_L = Work; float *const Work_L = Work;
float *const Work_TR = Work + 2 * *ldWork * (top ? n2_diff : n1) + 2 * n_rest; float *const Work_TR = Work + 2 * *ldWork * (top ? n2_diff : n1) + 2 * n_rest;
const int ldWork_L = top ? n1 : *ldWork; const blasint ldWork_L = top ? n1 : *ldWork;
// A_TL = A_TL - A_TR Work_TR' // A_TL = A_TL - A_TR Work_TR'
RELAPACK_cgemmt(uplo, "N", "T", &n1, &n2, MONE, A_TR, ldA, Work_TR, ldWork, ONE, A_TL, ldA); RELAPACK_cgemmt(uplo, "N", "T", &n1, &n2, MONE, A_TR, ldA, Work_TR, ldWork, ONE, A_TL, ldA);
BLAS(cgemm)("N", "T", &n_rest, &n1, &n2, MONE, A_TR_T, ldA, Work_TR, ldWork, ONE, A_TL_T, ldA); BLAS(cgemm)("N", "T", &n_rest, &n1, &n2, MONE, A_TR_T, ldA, Work_TR, ldWork, ONE, A_TL_T, ldA);
// recursion(A_TL) // recursion(A_TL)
int n1_out; blasint n1_out;
RELAPACK_csytrf_rec(uplo, &n_full1, &n1, &n1_out, A, ldA, ipiv, Work_L, &ldWork_L, &info1); RELAPACK_csytrf_rec(uplo, &n_full1, &n1, &n1_out, A, ldA, ipiv, Work_L, &ldWork_L, &info1);
if (n1_out != n1) { if (n1_out != n1) {
// undo 1 column of updates // undo 1 column of updates
const int n_restp1 = n_rest + 1; const blasint n_restp1 = n_rest + 1;
// A_TL_T_l = A_TL_T_l + A_TR_T Work_TR_t' // A_TL_T_l = A_TL_T_l + A_TR_T Work_TR_t'
BLAS(cgemv)("N", &n_restp1, &n2, ONE, A_TR_T, ldA, Work_TR, ldWork, ONE, A_TL_T, iONE); BLAS(cgemv)("N", &n_restp1, &n2, ONE, A_TR_T, ldA, Work_TR, ldWork, ONE, A_TL_T, iONE);

32
relapack/src/csytrf_rec2.c
View File

@ -15,7 +15,7 @@
/* Table of constant values */ /* Table of constant values */
static complex c_b1 = {1.f,0.f}; static complex c_b1 = {1.f,0.f};
static int c__1 = 1; static blasint c__1 = 1;
/** CSYTRF_REC2 computes a partial factorization of a complex symmetric matrix using the Bunch-Kaufman diagon al pivoting method. /** CSYTRF_REC2 computes a partial factorization of a complex symmetric matrix using the Bunch-Kaufman diagon al pivoting method.
* *
@ -24,12 +24,12 @@ static int c__1 = 1;
* The blocked BLAS Level 3 updates were removed and moved to the * The blocked BLAS Level 3 updates were removed and moved to the
* recursive algorithm. * recursive algorithm.
* */ * */
/* Subroutine */ void RELAPACK_csytrf_rec2(char *uplo, int *n, int * /* Subroutine */ void RELAPACK_csytrf_rec2(char *uplo, blasint *n, blasint *
nb, int *kb, complex *a, int *lda, int *ipiv, complex *w, nb, blasint *kb, complex *a, blasint *lda, blasint *ipiv, complex *w,
int *ldw, int *info, ftnlen uplo_len) int *ldw, blasint *info, ftnlen uplo_len)
{ {
/* System generated locals */ /* System generated locals */
int a_dim1, a_offset, w_dim1, w_offset, i__1, i__2, i__3, i__4; blasint a_dim1, a_offset, w_dim1, w_offset, i__1, i__2, i__3, i__4;
float r__1, r__2, r__3, r__4; float r__1, r__2, r__3, r__4;
complex q__1, q__2, q__3; complex q__1, q__2, q__3;
@ -38,21 +38,21 @@ static int c__1 = 1;
void c_div(complex *, complex *, complex *); void c_div(complex *, complex *, complex *);
/* Local variables */ /* Local variables */
static int j, k; static blasint j, k;
static complex t, r1, d11, d21, d22; static complex t, r1, d11, d21, d22;
static int jj, kk, jp, kp, kw, kkw, imax, jmax; static blasint jj, kk, jp, kp, kw, kkw, imax, jmax;
static float alpha; static float alpha;
extern /* Subroutine */ int cscal_(int *, complex *, complex *, extern /* Subroutine */ blasint cscal_(int *, complex *, complex *,
int *); blasint *);
extern logical lsame_(char *, char *, ftnlen, ftnlen); extern logical lsame_(char *, char *, ftnlen, ftnlen);
extern /* Subroutine */ int cgemv_(char *, int *, int *, complex * extern /* Subroutine */ blasint cgemv_(char *, blasint *, blasint *, complex *
, complex *, int *, complex *, int *, complex *, complex * , complex *, blasint *, complex *, blasint *, complex *, complex *
, int *, ftnlen), ccopy_(int *, complex *, int *, , blasint *, ftnlen), ccopy_(int *, complex *, blasint *,
complex *, int *), cswap_(int *, complex *, int *, complex *, blasint *), cswap_(int *, complex *, blasint *,
complex *, int *); complex *, blasint *);
static int kstep; static blasint kstep;
static float absakk; static float absakk;
extern int icamax_(int *, complex *, int *); extern blasint icamax_(int *, complex *, blasint *);
static float colmax, rowmax; static float colmax, rowmax;
/* Parameter adjustments */ /* Parameter adjustments */

72
relapack/src/csytrf_rook.c
View File

@ -3,8 +3,8 @@
#include <stdlib.h> #include <stdlib.h>
#endif #endif
static void RELAPACK_csytrf_rook_rec(const char *, const int *, const int *, int *, static void RELAPACK_csytrf_rook_rec(const char *, const blasint *, const blasint *, blasint *,
float *, const int *, int *, float *, const int *, int *); float *, const blasint *, blasint *, float *, const blasint *, blasint *);
/** CSYTRF_ROOK computes the factorization of a complex symmetric matrix A using the bounded Bunch-Kaufman ("rook") diagonal pivoting method. /** CSYTRF_ROOK computes the factorization of a complex symmetric matrix A using the bounded Bunch-Kaufman ("rook") diagonal pivoting method.
@ -14,21 +14,21 @@ static void RELAPACK_csytrf_rook_rec(const char *, const int *, const int *, int
* http://www.netlib.org/lapack/explore-html/d8/dc8/csytrf__rook_8f.html * http://www.netlib.org/lapack/explore-html/d8/dc8/csytrf__rook_8f.html
* */ * */
void RELAPACK_csytrf_rook( void RELAPACK_csytrf_rook(
const char *uplo, const int *n, const char *uplo, const blasint *n,
float *A, const int *ldA, int *ipiv, float *A, const blasint *ldA, blasint *ipiv,
float *Work, const int *lWork, int *info float *Work, const blasint *lWork, blasint *info
) { ) {
// Required work size // Required work size
const int cleanlWork = *n * (*n / 2); const blasint cleanlWork = *n * (*n / 2);
int minlWork = cleanlWork; blasint minlWork = cleanlWork;
#if XSYTRF_ALLOW_MALLOC #if XSYTRF_ALLOW_MALLOC
minlWork = 1; minlWork = 1;
#endif #endif
// Check arguments // Check arguments
const int lower = LAPACK(lsame)(uplo, "L"); const blasint lower = LAPACK(lsame)(uplo, "L");
const int upper = LAPACK(lsame)(uplo, "U"); const blasint upper = LAPACK(lsame)(uplo, "U");
*info = 0; *info = 0;
if (!lower && !upper) if (!lower && !upper)
*info = -1; *info = -1;
@ -55,8 +55,8 @@ void RELAPACK_csytrf_rook(
#endif #endif
if (*info) { if (*info) {
const int minfo = -*info; const blasint minfo = -*info;
LAPACK(xerbla)("CSYTRF", &minfo); LAPACK(xerbla)("CSYTRF", &minfo, strlen("CSYTRF"));
return; return;
} }
@ -64,7 +64,7 @@ void RELAPACK_csytrf_rook(
const char cleanuplo = lower ? 'L' : 'U'; const char cleanuplo = lower ? 'L' : 'U';
// Dummy argument // Dummy argument
int nout; blasint nout;
// Recursive kernel // Recursive kernel
RELAPACK_csytrf_rook_rec(&cleanuplo, n, n, &nout, A, ldA, ipiv, cleanWork, n, info); RELAPACK_csytrf_rook_rec(&cleanuplo, n, n, &nout, A, ldA, ipiv, cleanWork, n, info);
@ -78,13 +78,13 @@ void RELAPACK_csytrf_rook(
/** csytrf_rook's recursive compute kernel */ /** csytrf_rook's recursive compute kernel */
static void RELAPACK_csytrf_rook_rec( static void RELAPACK_csytrf_rook_rec(
const char *uplo, const int *n_full, const int *n, int *n_out, const char *uplo, const blasint *n_full, const blasint *n, blasint *n_out,
float *A, const int *ldA, int *ipiv, float *A, const blasint *ldA, blasint *ipiv,
float *Work, const int *ldWork, int *info float *Work, const blasint *ldWork, blasint *info
) { ) {
// top recursion level? // top recursion level?
const int top = *n_full == *n; const blasint top = *n_full == *n;
if (*n <= MAX(CROSSOVER_CSYTRF_ROOK, 3)) { if (*n <= MAX(CROSSOVER_CSYTRF_ROOK, 3)) {
// Unblocked // Unblocked
@ -96,31 +96,31 @@ static void RELAPACK_csytrf_rook_rec(
return; return;
} }
int info1, info2; blasint info1, info2;
// Constants // Constants
const float ONE[] = { 1., 0. }; const float ONE[] = { 1., 0. };
const float MONE[] = { -1., 0. }; const float MONE[] = { -1., 0. };
const int iONE[] = { 1 }; const blasint iONE[] = { 1 };
const int n_rest = *n_full - *n; const blasint n_rest = *n_full - *n;
if (*uplo == 'L') { if (*uplo == 'L') {
// Splitting (setup) // Splitting (setup)
int n1 = CREC_SPLIT(*n); blasint n1 = CREC_SPLIT(*n);
int n2 = *n - n1; blasint n2 = *n - n1;
// Work_L * // Work_L *
float *const Work_L = Work; float *const Work_L = Work;
// recursion(A_L) // recursion(A_L)
int n1_out; blasint n1_out;
RELAPACK_csytrf_rook_rec(uplo, n_full, &n1, &n1_out, A, ldA, ipiv, Work_L, ldWork, &info1); RELAPACK_csytrf_rook_rec(uplo, n_full, &n1, &n1_out, A, ldA, ipiv, Work_L, ldWork, &info1);
n1 = n1_out; n1 = n1_out;
// Splitting (continued) // Splitting (continued)
n2 = *n - n1; n2 = *n - n1;
const int n_full2 = *n_full - n1; const blasint n_full2 = *n_full - n1;
// * * // * *
// A_BL A_BR // A_BL A_BR
@ -136,23 +136,23 @@ static void RELAPACK_csytrf_rook_rec(
// (top recursion level: use Work as Work_BR) // (top recursion level: use Work as Work_BR)
float *const Work_BL = Work + 2 * n1; float *const Work_BL = Work + 2 * n1;
float *const Work_BR = top ? Work : Work + 2 * *ldWork * n1 + 2 * n1; float *const Work_BR = top ? Work : Work + 2 * *ldWork * n1 + 2 * n1;
const int ldWork_BR = top ? n2 : *ldWork; const blasint ldWork_BR = top ? n2 : *ldWork;
// ipiv_T // ipiv_T
// ipiv_B // ipiv_B
int *const ipiv_B = ipiv + n1; blasint *const ipiv_B = ipiv + n1;
// A_BR = A_BR - A_BL Work_BL' // A_BR = A_BR - A_BL Work_BL'
RELAPACK_cgemmt(uplo, "N", "T", &n2, &n1, MONE, A_BL, ldA, Work_BL, ldWork, ONE, A_BR, ldA); RELAPACK_cgemmt(uplo, "N", "T", &n2, &n1, MONE, A_BL, ldA, Work_BL, ldWork, ONE, A_BR, ldA);
BLAS(cgemm)("N", "T", &n_rest, &n2, &n1, MONE, A_BL_B, ldA, Work_BL, ldWork, ONE, A_BR_B, ldA); BLAS(cgemm)("N", "T", &n_rest, &n2, &n1, MONE, A_BL_B, ldA, Work_BL, ldWork, ONE, A_BR_B, ldA);
// recursion(A_BR) // recursion(A_BR)
int n2_out; blasint n2_out;
RELAPACK_csytrf_rook_rec(uplo, &n_full2, &n2, &n2_out, A_BR, ldA, ipiv_B, Work_BR, &ldWork_BR, &info2); RELAPACK_csytrf_rook_rec(uplo, &n_full2, &n2, &n2_out, A_BR, ldA, ipiv_B, Work_BR, &ldWork_BR, &info2);
if (n2_out != n2) { if (n2_out != n2) {
// undo 1 column of updates // undo 1 column of updates
const int n_restp1 = n_rest + 1; const blasint n_restp1 = n_rest + 1;
// last column of A_BR // last column of A_BR
float *const A_BR_r = A_BR + 2 * *ldA * n2_out + 2 * n2_out; float *const A_BR_r = A_BR + 2 * *ldA * n2_out + 2 * n2_out;
@ -169,7 +169,7 @@ static void RELAPACK_csytrf_rook_rec(
n2 = n2_out; n2 = n2_out;
// shift pivots // shift pivots
int i; blasint i;
for (i = 0; i < n2; i++) for (i = 0; i < n2; i++)
if (ipiv_B[i] > 0) if (ipiv_B[i] > 0)
ipiv_B[i] += n1; ipiv_B[i] += n1;
@ -180,22 +180,22 @@ static void RELAPACK_csytrf_rook_rec(
*n_out = n1 + n2; *n_out = n1 + n2;
} else { } else {
// Splitting (setup) // Splitting (setup)
int n2 = CREC_SPLIT(*n); blasint n2 = CREC_SPLIT(*n);
int n1 = *n - n2; blasint n1 = *n - n2;
// * Work_R // * Work_R
// (top recursion level: use Work as Work_R) // (top recursion level: use Work as Work_R)
float *const Work_R = top ? Work : Work + 2 * *ldWork * n1; float *const Work_R = top ? Work : Work + 2 * *ldWork * n1;
// recursion(A_R) // recursion(A_R)
int n2_out; blasint n2_out;
RELAPACK_csytrf_rook_rec(uplo, n_full, &n2, &n2_out, A, ldA, ipiv, Work_R, ldWork, &info2); RELAPACK_csytrf_rook_rec(uplo, n_full, &n2, &n2_out, A, ldA, ipiv, Work_R, ldWork, &info2);
const int n2_diff = n2 - n2_out; const blasint n2_diff = n2 - n2_out;
n2 = n2_out; n2 = n2_out;
// Splitting (continued) // Splitting (continued)
n1 = *n - n2; n1 = *n - n2;
const int n_full1 = *n_full - n2; const blasint n_full1 = *n_full - n2;
// * A_TL_T A_TR_T // * A_TL_T A_TR_T
// * A_TL A_TR // * A_TL A_TR
@ -211,19 +211,19 @@ static void RELAPACK_csytrf_rook_rec(
// (top recursion level: Work_R was Work) // (top recursion level: Work_R was Work)
float *const Work_L = Work; float *const Work_L = Work;
float *const Work_TR = Work + 2 * *ldWork * (top ? n2_diff : n1) + 2 * n_rest; float *const Work_TR = Work + 2 * *ldWork * (top ? n2_diff : n1) + 2 * n_rest;
const int ldWork_L = top ? n1 : *ldWork; const blasint ldWork_L = top ? n1 : *ldWork;
// A_TL = A_TL - A_TR Work_TR' // A_TL = A_TL - A_TR Work_TR'
RELAPACK_cgemmt(uplo, "N", "T", &n1, &n2, MONE, A_TR, ldA, Work_TR, ldWork, ONE, A_TL, ldA); RELAPACK_cgemmt(uplo, "N", "T", &n1, &n2, MONE, A_TR, ldA, Work_TR, ldWork, ONE, A_TL, ldA);
BLAS(cgemm)("N", "T", &n_rest, &n1, &n2, MONE, A_TR_T, ldA, Work_TR, ldWork, ONE, A_TL_T, ldA); BLAS(cgemm)("N", "T", &n_rest, &n1, &n2, MONE, A_TR_T, ldA, Work_TR, ldWork, ONE, A_TL_T, ldA);
// recursion(A_TL) // recursion(A_TL)
int n1_out; blasint n1_out;
RELAPACK_csytrf_rook_rec(uplo, &n_full1, &n1, &n1_out, A, ldA, ipiv, Work_L, &ldWork_L, &info1); RELAPACK_csytrf_rook_rec(uplo, &n_full1, &n1, &n1_out, A, ldA, ipiv, Work_L, &ldWork_L, &info1);
if (n1_out != n1) { if (n1_out != n1) {
// undo 1 column of updates // undo 1 column of updates
const int n_restp1 = n_rest + 1; const blasint n_restp1 = n_rest + 1;
// A_TL_T_l = A_TL_T_l + A_TR_T Work_TR_t' // A_TL_T_l = A_TL_T_l + A_TR_T Work_TR_t'
BLAS(cgemv)("N", &n_restp1, &n2, ONE, A_TR_T, ldA, Work_TR, ldWork, ONE, A_TL_T, iONE); BLAS(cgemv)("N", &n_restp1, &n2, ONE, A_TR_T, ldA, Work_TR, ldWork, ONE, A_TL_T, iONE);

40
relapack/src/csytrf_rook_rec2.c
View File

@ -15,7 +15,7 @@
/* Table of constant values */ /* Table of constant values */
static complex c_b1 = {1.f,0.f}; static complex c_b1 = {1.f,0.f};
static int c__1 = 1; static blasint c__1 = 1;
/** CSYTRF_ROOK_REC2 computes a partial factorization of a complex symmetric matrix using the bounded Bunch-K aufman ("rook") diagonal pivoting method. /** CSYTRF_ROOK_REC2 computes a partial factorization of a complex symmetric matrix using the bounded Bunch-K aufman ("rook") diagonal pivoting method.
* *
@ -24,12 +24,12 @@ static int c__1 = 1;
* The blocked BLAS Level 3 updates were removed and moved to the * The blocked BLAS Level 3 updates were removed and moved to the
* recursive algorithm. * recursive algorithm.
* */ * */
/* Subroutine */ void RELAPACK_csytrf_rook_rec2(char *uplo, int *n, /* Subroutine */ void RELAPACK_csytrf_rook_rec2(char *uplo, blasint *n,
int *nb, int *kb, complex *a, int *lda, int *ipiv, int *nb, blasint *kb, complex *a, blasint *lda, blasint *ipiv,
complex *w, int *ldw, int *info, ftnlen uplo_len) complex *w, blasint *ldw, blasint *info, ftnlen uplo_len)
{ {
/* System generated locals */ /* System generated locals */
int a_dim1, a_offset, w_dim1, w_offset, i__1, i__2, i__3, i__4; blasint a_dim1, a_offset, w_dim1, w_offset, i__1, i__2, i__3, i__4;
float r__1, r__2; float r__1, r__2;
complex q__1, q__2, q__3, q__4; complex q__1, q__2, q__3, q__4;
@ -38,27 +38,27 @@ static int c__1 = 1;
void c_div(complex *, complex *, complex *); void c_div(complex *, complex *, complex *);
/* Local variables */ /* Local variables */
static int j, k, p; static blasint j, k, p;
static complex t, r1, d11, d12, d21, d22; static complex t, r1, d11, d12, d21, d22;
static int ii, jj, kk, kp, kw, jp1, jp2, kkw; static blasint ii, jj, kk, kp, kw, jp1, jp2, kkw;
static logical done; static logical done;
static int imax, jmax; static blasint imax, jmax;
static float alpha; static float alpha;
extern /* Subroutine */ int cscal_(int *, complex *, complex *, extern /* Subroutine */ blasint cscal_(int *, complex *, complex *,
int *); blasint *);
extern logical lsame_(char *, char *, ftnlen, ftnlen); extern logical lsame_(char *, char *, ftnlen, ftnlen);
extern /* Subroutine */ int cgemv_(char *, int *, int *, complex * extern /* Subroutine */ blasint cgemv_(char *, blasint *, blasint *, complex *
, complex *, int *, complex *, int *, complex *, complex * , complex *, blasint *, complex *, blasint *, complex *, complex *
, int *, ftnlen); , blasint *, ftnlen);
static float sfmin; static float sfmin;
extern /* Subroutine */ int ccopy_(int *, complex *, int *, extern /* Subroutine */ blasint ccopy_(int *, complex *, blasint *,
complex *, int *); complex *, blasint *);
static int itemp; static blasint itemp;
extern /* Subroutine */ int cswap_(int *, complex *, int *, extern /* Subroutine */ blasint cswap_(int *, complex *, blasint *,
complex *, int *); complex *, blasint *);
static int kstep; static blasint kstep;
static float stemp, absakk; static float stemp, absakk;
extern int icamax_(int *, complex *, int *); extern blasint icamax_(int *, complex *, blasint *);
extern double slamch_(char *, ftnlen); extern double slamch_(char *, ftnlen);
static float colmax, rowmax; static float colmax, rowmax;

62
relapack/src/ctgsyl.c
View File

@ -1,10 +1,10 @@
#include "relapack.h" #include "relapack.h"
#include <math.h> #include <math.h>
static void RELAPACK_ctgsyl_rec(const char *, const int *, const int *, static void RELAPACK_ctgsyl_rec(const char *, const blasint *, const blasint *,
const int *, const float *, const int *, const float *, const int *, const blasint *, const float *, const blasint *, const float *, const blasint *,
float *, const int *, const float *, const int *, const float *, float *, const blasint *, const float *, const blasint *, const float *,
const int *, float *, const int *, float *, float *, float *, int *); const blasint *, float *, const blasint *, float *, float *, float *, blasint *);
/** CTGSYL solves the generalized Sylvester equation. /** CTGSYL solves the generalized Sylvester equation.
@ -14,21 +14,21 @@ static void RELAPACK_ctgsyl_rec(const char *, const int *, const int *,
* http://www.netlib.org/lapack/explore-html/d7/de7/ctgsyl_8f.html * http://www.netlib.org/lapack/explore-html/d7/de7/ctgsyl_8f.html
* */ * */
void RELAPACK_ctgsyl( void RELAPACK_ctgsyl(
const char *trans, const int *ijob, const int *m, const int *n, const char *trans, const blasint *ijob, const blasint *m, const blasint *n,
const float *A, const int *ldA, const float *B, const int *ldB, const float *A, const blasint *ldA, const float *B, const blasint *ldB,
float *C, const int *ldC, float *C, const blasint *ldC,
const float *D, const int *ldD, const float *E, const int *ldE, const float *D, const blasint *ldD, const float *E, const blasint *ldE,
float *F, const int *ldF, float *F, const blasint *ldF,
float *scale, float *dif, float *scale, float *dif,
float *Work, const int *lWork, int *iWork, int *info float *Work, const blasint *lWork, blasint *iWork, blasint *info
) { ) {
// Parse arguments // Parse arguments
const int notran = LAPACK(lsame)(trans, "N"); const blasint notran = LAPACK(lsame)(trans, "N");
const int tran = LAPACK(lsame)(trans, "C"); const blasint tran = LAPACK(lsame)(trans, "C");
// Compute work buffer size // Compute work buffer size
int lwmin = 1; blasint lwmin = 1;
if (notran && (*ijob == 1 || *ijob == 2)) if (notran && (*ijob == 1 || *ijob == 2))
lwmin = MAX(1, 2 * *m * *n); lwmin = MAX(1, 2 * *m * *n);
*info = 0; *info = 0;
@ -57,8 +57,8 @@ void RELAPACK_ctgsyl(
else if (*lWork < lwmin && *lWork != -1) else if (*lWork < lwmin && *lWork != -1)
*info = -20; *info = -20;
if (*info) { if (*info) {
const int minfo = -*info; const blasint minfo = -*info;
LAPACK(xerbla)("CTGSYL", &minfo); LAPACK(xerbla)("CTGSYL", &minfo, strlen("CTGSYL"));
return; return;
} }
@ -74,8 +74,8 @@ void RELAPACK_ctgsyl(
// Constant // Constant
const float ZERO[] = { 0., 0. }; const float ZERO[] = { 0., 0. };
int isolve = 1; blasint isolve = 1;
int ifunc = 0; blasint ifunc = 0;
if (notran) { if (notran) {
if (*ijob >= 3) { if (*ijob >= 3) {
ifunc = *ijob - 2; ifunc = *ijob - 2;
@ -86,7 +86,7 @@ void RELAPACK_ctgsyl(
} }
float scale2; float scale2;
int iround; blasint iround;
for (iround = 1; iround <= isolve; iround++) { for (iround = 1; iround <= isolve; iround++) {
*scale = 1; *scale = 1;
float dscale = 0; float dscale = 0;
@ -119,13 +119,13 @@ void RELAPACK_ctgsyl(
/** ctgsyl's recursive vompute kernel */ /** ctgsyl's recursive vompute kernel */
static void RELAPACK_ctgsyl_rec( static void RELAPACK_ctgsyl_rec(
const char *trans, const int *ifunc, const int *m, const int *n, const char *trans, const blasint *ifunc, const blasint *m, const blasint *n,
const float *A, const int *ldA, const float *B, const int *ldB, const float *A, const blasint *ldA, const float *B, const blasint *ldB,
float *C, const int *ldC, float *C, const blasint *ldC,
const float *D, const int *ldD, const float *E, const int *ldE, const float *D, const blasint *ldD, const float *E, const blasint *ldE,
float *F, const int *ldF, float *F, const blasint *ldF,
float *scale, float *dsum, float *dscale, float *scale, float *dsum, float *dscale,
int *info blasint *info
) { ) {
if (*m <= MAX(CROSSOVER_CTGSYL, 1) && *n <= MAX(CROSSOVER_CTGSYL, 1)) { if (*m <= MAX(CROSSOVER_CTGSYL, 1) && *n <= MAX(CROSSOVER_CTGSYL, 1)) {
@ -137,18 +137,18 @@ static void RELAPACK_ctgsyl_rec(
// Constants // Constants
const float ONE[] = { 1., 0. }; const float ONE[] = { 1., 0. };
const float MONE[] = { -1., 0. }; const float MONE[] = { -1., 0. };
const int iONE[] = { 1 }; const blasint iONE[] = { 1 };
// Outputs // Outputs
float scale1[] = { 1., 0. }; float scale1[] = { 1., 0. };
float scale2[] = { 1., 0. }; float scale2[] = { 1., 0. };
int info1[] = { 0 }; blasint info1[] = { 0 };
int info2[] = { 0 }; blasint info2[] = { 0 };
if (*m > *n) { if (*m > *n) {
// Splitting // Splitting
const int m1 = CREC_SPLIT(*m); const blasint m1 = CREC_SPLIT(*m);
const int m2 = *m - m1; const blasint m2 = *m - m1;
// A_TL A_TR // A_TL A_TR
// 0 A_BR // 0 A_BR
@ -206,8 +206,8 @@ static void RELAPACK_ctgsyl_rec(
} }
} else { } else {
// Splitting // Splitting
const int n1 = CREC_SPLIT(*n); const blasint n1 = CREC_SPLIT(*n);
const int n2 = *n - n1; const blasint n2 = *n - n1;
// B_TL B_TR // B_TL B_TR
// 0 B_BR // 0 B_BR

52
relapack/src/ctrsyl.c
View File

@ -1,8 +1,8 @@
#include "relapack.h" #include "relapack.h"
static void RELAPACK_ctrsyl_rec(const char *, const char *, const int *, static void RELAPACK_ctrsyl_rec(const char *, const char *, const blasint *,
const int *, const int *, const float *, const int *, const float *, const blasint *, const blasint *, const float *, const blasint *, const float *,
const int *, float *, const int *, float *, int *); const blasint *, float *, const blasint *, float *, blasint *);
/** CTRSYL solves the complex Sylvester matrix equation. /** CTRSYL solves the complex Sylvester matrix equation.
@ -12,18 +12,18 @@ static void RELAPACK_ctrsyl_rec(const char *, const char *, const int *,
* http://www.netlib.org/lapack/explore-html/d8/df4/ctrsyl_8f.html * http://www.netlib.org/lapack/explore-html/d8/df4/ctrsyl_8f.html
* */ * */
void RELAPACK_ctrsyl( void RELAPACK_ctrsyl(
const char *tranA, const char *tranB, const int *isgn, const char *tranA, const char *tranB, const blasint *isgn,
const int *m, const int *n, const blasint *m, const blasint *n,
const float *A, const int *ldA, const float *B, const int *ldB, const float *A, const blasint *ldA, const float *B, const blasint *ldB,
float *C, const int *ldC, float *scale, float *C, const blasint *ldC, float *scale,
int *info blasint *info
) { ) {
// Check arguments // Check arguments
const int notransA = LAPACK(lsame)(tranA, "N"); const blasint notransA = LAPACK(lsame)(tranA, "N");
const int ctransA = LAPACK(lsame)(tranA, "C"); const blasint ctransA = LAPACK(lsame)(tranA, "C");
const int notransB = LAPACK(lsame)(tranB, "N"); const blasint notransB = LAPACK(lsame)(tranB, "N");
const int ctransB = LAPACK(lsame)(tranB, "C"); const blasint ctransB = LAPACK(lsame)(tranB, "C");
*info = 0; *info = 0;
if (!ctransA && !notransA) if (!ctransA && !notransA)
*info = -1; *info = -1;
@ -42,8 +42,8 @@ void RELAPACK_ctrsyl(
else if (*ldC < MAX(1, *m)) else if (*ldC < MAX(1, *m))
*info = -11; *info = -11;
if (*info) { if (*info) {
const int minfo = -*info; const blasint minfo = -*info;
LAPACK(xerbla)("CTRSYL", &minfo); LAPACK(xerbla)("CTRSYL", &minfo, strlen("CTRSYL"));
return; return;
} }
@ -58,11 +58,11 @@ void RELAPACK_ctrsyl(
/** ctrsyl's recursive compute kernel */ /** ctrsyl's recursive compute kernel */
static void RELAPACK_ctrsyl_rec( static void RELAPACK_ctrsyl_rec(
const char *tranA, const char *tranB, const int *isgn, const char *tranA, const char *tranB, const blasint *isgn,
const int *m, const int *n, const blasint *m, const blasint *n,
const float *A, const int *ldA, const float *B, const int *ldB, const float *A, const blasint *ldA, const float *B, const blasint *ldB,
float *C, const int *ldC, float *scale, float *C, const blasint *ldC, float *scale,
int *info blasint *info
) { ) {
if (*m <= MAX(CROSSOVER_CTRSYL, 1) && *n <= MAX(CROSSOVER_CTRSYL, 1)) { if (*m <= MAX(CROSSOVER_CTRSYL, 1) && *n <= MAX(CROSSOVER_CTRSYL, 1)) {
@ -75,18 +75,18 @@ static void RELAPACK_ctrsyl_rec(
const float ONE[] = { 1., 0. }; const float ONE[] = { 1., 0. };
const float MONE[] = { -1., 0. }; const float MONE[] = { -1., 0. };
const float MSGN[] = { -*isgn, 0. }; const float MSGN[] = { -*isgn, 0. };
const int iONE[] = { 1 }; const blasint iONE[] = { 1 };
// Outputs // Outputs
float scale1[] = { 1., 0. }; float scale1[] = { 1., 0. };
float scale2[] = { 1., 0. }; float scale2[] = { 1., 0. };
int info1[] = { 0 }; blasint info1[] = { 0 };
int info2[] = { 0 }; blasint info2[] = { 0 };
if (*m > *n) { if (*m > *n) {
// Splitting // Splitting
const int m1 = CREC_SPLIT(*m); const blasint m1 = CREC_SPLIT(*m);
const int m2 = *m - m1; const blasint m2 = *m - m1;
// A_TL A_TR // A_TL A_TR
// 0 A_BR // 0 A_BR
@ -122,8 +122,8 @@ static void RELAPACK_ctrsyl_rec(
} }
} else { } else {
// Splitting // Splitting
const int n1 = CREC_SPLIT(*n); const blasint n1 = CREC_SPLIT(*n);
const int n2 = *n - n1; const blasint n2 = *n - n1;
// B_TL B_TR // B_TL B_TR
// 0 B_BR // 0 B_BR

36
relapack/src/ctrsyl_rec2.c
View File

@ -14,16 +14,16 @@
#include "f2c.h" #include "f2c.h"
#if BLAS_COMPLEX_FUNCTIONS_AS_ROUTINES #if BLAS_COMPLEX_FUNCTIONS_AS_ROUTINES
complex cdotu_fun(int *n, complex *x, int *incx, complex *y, int *incy) { complex cdotu_fun(int *n, complex *x, blasint *incx, complex *y, blasint *incy) {
extern void cdotu_(complex *, int *, complex *, int *, complex *, int *); extern void cdotu_(complex *, blasint *, complex *, blasint *, complex *, blasint *);
complex result; complex result;
cdotu_(&result, n, x, incx, y, incy); cdotu_(&result, n, x, incx, y, incy);
return result; return result;
} }
#define cdotu_ cdotu_fun #define cdotu_ cdotu_fun
complex cdotc_fun(int *n, complex *x, int *incx, complex *y, int *incy) { complex cdotc_fun(int *n, complex *x, blasint *incx, complex *y, blasint *incy) {
extern void cdotc_(complex *, int *, complex *, int *, complex *, int *); extern void cdotc_(complex *, blasint *, complex *, blasint *, complex *, blasint *);
complex result; complex result;
cdotc_(&result, n, x, incx, y, incy); cdotc_(&result, n, x, incx, y, incy);
return result; return result;
@ -43,7 +43,7 @@ complex cladiv_fun(complex *a, complex *b) {
/* Table of constant values */ /* Table of constant values */
static int c__1 = 1; static blasint c__1 = 1;
/** RELAPACK_CTRSYL_REC2 solves the complex Sylvester matrix equation (unblocked algorithm) /** RELAPACK_CTRSYL_REC2 solves the complex Sylvester matrix equation (unblocked algorithm)
* *
@ -51,12 +51,12 @@ static int c__1 = 1;
* It serves as an unblocked kernel in the recursive algorithms. * It serves as an unblocked kernel in the recursive algorithms.
* */ * */
/* Subroutine */ void RELAPACK_ctrsyl_rec2(char *trana, char *tranb, int /* Subroutine */ void RELAPACK_ctrsyl_rec2(char *trana, char *tranb, int
*isgn, int *m, int *n, complex *a, int *lda, complex *b, *isgn, blasint *m, blasint *n, complex *a, blasint *lda, complex *b,
int *ldb, complex *c__, int *ldc, float *scale, int *info, int *ldb, complex *c__, blasint *ldc, float *scale, blasint *info,
ftnlen trana_len, ftnlen tranb_len) ftnlen trana_len, ftnlen tranb_len)
{ {
/* System generated locals */ /* System generated locals */
int a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2, blasint a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2,
i__3, i__4; i__3, i__4;
float r__1, r__2; float r__1, r__2;
complex q__1, q__2, q__3, q__4; complex q__1, q__2, q__3, q__4;
@ -66,7 +66,7 @@ static int c__1 = 1;
void r_cnjg(complex *, complex *); void r_cnjg(complex *, complex *);
/* Local variables */ /* Local variables */
static int j, k, l; static blasint j, k, l;
static complex a11; static complex a11;
static float db; static float db;
static complex x11; static complex x11;
@ -75,20 +75,20 @@ static int c__1 = 1;
static float dum[1], eps, sgn, smin; static float dum[1], eps, sgn, smin;
static complex suml, sumr; static complex suml, sumr;
/* Complex */ complex cdotc_(int *, complex *, int /* Complex */ complex cdotc_(int *, complex *, int
*, complex *, int *); *, complex *, blasint *);
extern int lsame_(char *, char *, ftnlen, ftnlen); extern blasint lsame_(char *, char *, ftnlen, ftnlen);
/* Complex */ complex cdotu_(int *, complex *, int /* Complex */ complex cdotu_(int *, complex *, int
*, complex *, int *); *, complex *, blasint *);
extern /* Subroutine */ int slabad_(float *, float *); extern /* Subroutine */ blasint slabad_(float *, float *);
extern float clange_(char *, int *, int *, complex *, extern float clange_(char *, blasint *, blasint *, complex *,
int *, float *, ftnlen); blasint *, float *, ftnlen);
/* Complex */ complex cladiv_(complex *, complex *); /* Complex */ complex cladiv_(complex *, complex *);
static float scaloc; static float scaloc;
extern float slamch_(char *, ftnlen); extern float slamch_(char *, ftnlen);
extern /* Subroutine */ int csscal_(int *, float *, complex *, int extern /* Subroutine */ blasint csscal_(int *, float *, complex *, int
*), xerbla_(char *, int *, ftnlen); *), xerbla_(char *, blasint *, ftnlen);
static float bignum; static float bignum;
static int notrna, notrnb; static blasint notrna, notrnb;
static float smlnum; static float smlnum;
/* Parameter adjustments */ /* Parameter adjustments */

34
relapack/src/ctrtri.c
View File

@ -1,7 +1,7 @@
#include "relapack.h" #include "relapack.h"
static void RELAPACK_ctrtri_rec(const char *, const char *, const int *, static void RELAPACK_ctrtri_rec(const char *, const char *, const blasint *,
float *, const int *, int *); float *, const blasint *, blasint *);
/** CTRTRI computes the inverse of a complex upper or lower triangular matrix A. /** CTRTRI computes the inverse of a complex upper or lower triangular matrix A.
@ -11,16 +11,16 @@ static void RELAPACK_ctrtri_rec(const char *, const char *, const int *,
* http://www.netlib.org/lapack/explore-html/df/df8/ctrtri_8f.html * http://www.netlib.org/lapack/explore-html/df/df8/ctrtri_8f.html
* */ * */
void RELAPACK_ctrtri( void RELAPACK_ctrtri(
const char *uplo, const char *diag, const int *n, const char *uplo, const char *diag, const blasint *n,
float *A, const int *ldA, float *A, const blasint *ldA,
int *info blasint *info
) { ) {
// Check arguments // Check arguments
const int lower = LAPACK(lsame)(uplo, "L"); const blasint lower = LAPACK(lsame)(uplo, "L");
const int upper = LAPACK(lsame)(uplo, "U"); const blasint upper = LAPACK(lsame)(uplo, "U");
const int nounit = LAPACK(lsame)(diag, "N"); const blasint nounit = LAPACK(lsame)(diag, "N");
const int unit = LAPACK(lsame)(diag, "U"); const blasint unit = LAPACK(lsame)(diag, "U");
*info = 0; *info = 0;
if (!lower && !upper) if (!lower && !upper)
*info = -1; *info = -1;
@ -31,8 +31,8 @@ void RELAPACK_ctrtri(
else if (*ldA < MAX(1, *n)) else if (*ldA < MAX(1, *n))
*info = -5; *info = -5;
if (*info) { if (*info) {
const int minfo = -*info; const blasint minfo = -*info;
LAPACK(xerbla)("CTRTRI", &minfo); LAPACK(xerbla)("CTRTRI", &minfo, strlen("CTRTRI"));
return; return;
} }
@ -42,7 +42,7 @@ void RELAPACK_ctrtri(
// check for singularity // check for singularity
if (nounit) { if (nounit) {
int i; blasint i;
for (i = 0; i < *n; i++) for (i = 0; i < *n; i++)
if (A[2 * (i + *ldA * i)] == 0 && A[2 * (i + *ldA * i) + 1] == 0) { if (A[2 * (i + *ldA * i)] == 0 && A[2 * (i + *ldA * i) + 1] == 0) {
*info = i; *info = i;
@ -57,9 +57,9 @@ void RELAPACK_ctrtri(
/** ctrtri's recursive compute kernel */ /** ctrtri's recursive compute kernel */
static void RELAPACK_ctrtri_rec( static void RELAPACK_ctrtri_rec(
const char *uplo, const char *diag, const int *n, const char *uplo, const char *diag, const blasint *n,
float *A, const int *ldA, float *A, const blasint *ldA,
int *info blasint *info
){ ){
if (*n <= MAX(CROSSOVER_CTRTRI, 1)) { if (*n <= MAX(CROSSOVER_CTRTRI, 1)) {
@ -73,8 +73,8 @@ static void RELAPACK_ctrtri_rec(
const float MONE[] = { -1., 0. }; const float MONE[] = { -1., 0. };
// Splitting // Splitting
const int n1 = CREC_SPLIT(*n); const blasint n1 = CREC_SPLIT(*n);
const int n2 = *n - n1; const blasint n2 = *n - n1;
// A_TL A_TR // A_TL A_TR
// A_BL A_BR // A_BL A_BR

80
relapack/src/dgbtrf.c
View File

@ -1,9 +1,8 @@
#include "relapack.h" #include "relapack.h"
#include "stdlib.h" #include "stdlib.h"
static void RELAPACK_dgbtrf_rec(const blasint *, const blasint *, const blasint *,
static void RELAPACK_dgbtrf_rec(const int *, const int *, const int *, const blasint *, double *, const blasint *, blasint *, double *, const blasint *, double *,
const int *, double *, const int *, int *, double *, const int *, double *, const blasint *, blasint *);
const int *, int *);
/** DGBTRF computes an LU factorization of a real m-by-n band matrix A using partial pivoting with row interchanges. /** DGBTRF computes an LU factorization of a real m-by-n band matrix A using partial pivoting with row interchanges.
@ -13,9 +12,9 @@ static void RELAPACK_dgbtrf_rec(const int *, const int *, const int *,
* http://www.netlib.org/lapack/explore-html/da/d87/dgbtrf_8f.html * http://www.netlib.org/lapack/explore-html/da/d87/dgbtrf_8f.html
* */ * */
void RELAPACK_dgbtrf( void RELAPACK_dgbtrf(
const int *m, const int *n, const int *kl, const int *ku, const blasint *m, const blasint *n, const blasint *kl, const blasint *ku,
double *Ab, const int *ldAb, int *ipiv, double *Ab, const blasint *ldAb, blasint *ipiv,
int *info blasint *info
) { ) {
// Check arguments // Check arguments
@ -31,8 +30,8 @@ void RELAPACK_dgbtrf(
else if (*ldAb < 2 * *kl + *ku + 1) else if (*ldAb < 2 * *kl + *ku + 1)
*info = -6; *info = -6;
if (*info) { if (*info) {
const int minfo = -*info; const blasint minfo = -*info;
LAPACK(xerbla)("DGBTRF", &minfo); LAPACK(xerbla)("DGBTRF", &minfo, strlen("DGBTRF"));
return; return;
} }
@ -40,14 +39,14 @@ void RELAPACK_dgbtrf(
const double ZERO[] = { 0. }; const double ZERO[] = { 0. };
// Result upper band width // Result upper band width
const int kv = *ku + *kl; const blasint kv = *ku + *kl;
// Unskew A // Unskew A
const int ldA[] = { *ldAb - 1 }; const blasint ldA[] = { *ldAb - 1 };
double *const A = Ab + kv; double *const A = Ab + kv;
// Zero upper diagonal fill-in elements // Zero upper diagonal fill-in elements
int i, j; blasint i, j;
for (j = 0; j < *n; j++) { for (j = 0; j < *n; j++) {
double *const A_j = A + *ldA * j; double *const A_j = A + *ldA * j;
for (i = MAX(0, j - kv); i < j - *ku; i++) for (i = MAX(0, j - kv); i < j - *ku; i++)
@ -55,11 +54,12 @@ void RELAPACK_dgbtrf(
} }
// Allocate work space // Allocate work space
const int n1 = DREC_SPLIT(*n); const blasint n1 = DREC_SPLIT(*n);
const int mWorkl = (kv > n1) ? MAX(1, *m - *kl) : kv; const blasint mWorkl = abs( (kv > n1) ? MAX(1, *m - *kl) : kv);
const int nWorkl = (kv > n1) ? n1 : kv; const blasint nWorkl = abs( (kv > n1) ? n1 : kv);
const int mWorku = (*kl > n1) ? n1 : *kl; const blasint mWorku = abs( (*kl > n1) ? n1 : *kl);
const int nWorku = (*kl > n1) ? MAX(0, *n - *kl) : *kl; // const blasint nWorku = abs( (*kl > n1) ? MAX(0, *n - *kl) : *kl);
const blasint nWorku = abs( (*kl > n1) ? MAX(1, *n - *kl) : *kl);
double *Workl = malloc(mWorkl * nWorkl * sizeof(double)); double *Workl = malloc(mWorkl * nWorkl * sizeof(double));
double *Worku = malloc(mWorku * nWorku * sizeof(double)); double *Worku = malloc(mWorku * nWorku * sizeof(double));
LAPACK(dlaset)("L", &mWorkl, &nWorkl, ZERO, ZERO, Workl, &mWorkl); LAPACK(dlaset)("L", &mWorkl, &nWorkl, ZERO, ZERO, Workl, &mWorkl);
@ -76,10 +76,10 @@ void RELAPACK_dgbtrf(
/** dgbtrf's recursive compute kernel */ /** dgbtrf's recursive compute kernel */
static void RELAPACK_dgbtrf_rec( static void RELAPACK_dgbtrf_rec(
const int *m, const int *n, const int *kl, const int *ku, const blasint *m, const blasint *n, const blasint *kl, const blasint *ku,
double *Ab, const int *ldAb, int *ipiv, double *Ab, const blasint *ldAb, blasint *ipiv,
double *Workl, const int *ldWorkl, double *Worku, const int *ldWorku, double *Workl, const blasint *ldWorkl, double *Worku, const blasint *ldWorku,
int *info blasint *info
) { ) {
if (*n <= MAX(CROSSOVER_DGBTRF, 1)) { if (*n <= MAX(CROSSOVER_DGBTRF, 1)) {
@ -91,25 +91,25 @@ static void RELAPACK_dgbtrf_rec(
// Constants // Constants
const double ONE[] = { 1. }; const double ONE[] = { 1. };
const double MONE[] = { -1. }; const double MONE[] = { -1. };
const int iONE[] = { 1 }; const blasint iONE[] = { 1 };
// Loop iterators // Loop iterators
int i, j; blasint i, j;
// Output upper band width // Output upper band width
const int kv = *ku + *kl; const blasint kv = *ku + *kl;
// Unskew A // Unskew A
const int ldA[] = { *ldAb - 1 }; const blasint ldA[] = { *ldAb - 1 };
double *const A = Ab + kv; double *const A = Ab + kv;
// Splitting // Splitting
const int n1 = MIN(DREC_SPLIT(*n), *kl); const blasint n1 = MIN(DREC_SPLIT(*n), *kl);
const int n2 = *n - n1; const blasint n2 = *n - n1;
const int m1 = MIN(n1, *m); const blasint m1 = MIN(n1, *m);
const int m2 = *m - m1; const blasint m2 = *m - m1;
const int mn1 = MIN(m1, n1); const blasint mn1 = MIN(m1, n1);
const int mn2 = MIN(m2, n2); const blasint mn2 = MIN(m2, n2);
// Ab_L * // Ab_L *
// Ab_BR // Ab_BR
@ -129,14 +129,14 @@ static void RELAPACK_dgbtrf_rec(
// ipiv_T // ipiv_T
// ipiv_B // ipiv_B
int *const ipiv_T = ipiv; blasint *const ipiv_T = ipiv;
int *const ipiv_B = ipiv + n1; blasint *const ipiv_B = ipiv + n1;
// Banded splitting // Banded splitting
const int n21 = MIN(n2, kv - n1); const blasint n21 = MIN(n2, kv - n1);
const int n22 = MIN(n2 - n21, n1); const blasint n22 = MIN(n2 - n21, n1);
const int m21 = MIN(m2, *kl - m1); const blasint m21 = MIN(m2, *kl - m1);
const int m22 = MIN(m2 - m21, m1); const blasint m22 = MIN(m2 - m21, m1);
// n1 n21 n22 // n1 n21 n22
// m * A_Rl ARr // m * A_Rl ARr
@ -164,7 +164,7 @@ static void RELAPACK_dgbtrf_rec(
// partially redo swaps in A_L // partially redo swaps in A_L
for (i = 0; i < mn1; i++) { for (i = 0; i < mn1; i++) {
const int ip = ipiv_T[i] - 1; const blasint ip = ipiv_T[i] - 1;
if (ip != i) { if (ip != i) {
if (ip < *kl) if (ip < *kl)
BLAS(dswap)(&i, A_L + i, ldA, A_L + ip, ldA); BLAS(dswap)(&i, A_L + i, ldA, A_L + ip, ldA);
@ -180,7 +180,7 @@ static void RELAPACK_dgbtrf_rec(
for (j = 0; j < n22; j++) { for (j = 0; j < n22; j++) {
double *const A_Rrj = A_Rr + *ldA * j; double *const A_Rrj = A_Rr + *ldA * j;
for (i = j; i < mn1; i++) { for (i = j; i < mn1; i++) {
const int ip = ipiv_T[i] - 1; const blasint ip = ipiv_T[i] - 1;
if (ip != i) { if (ip != i) {
const double tmp = A_Rrj[i]; const double tmp = A_Rrj[i];
A_Rrj[i] = A_Rr[ip]; A_Rrj[i] = A_Rr[ip];
@ -208,7 +208,7 @@ static void RELAPACK_dgbtrf_rec(
// partially undo swaps in A_L // partially undo swaps in A_L
for (i = mn1 - 1; i >= 0; i--) { for (i = mn1 - 1; i >= 0; i--) {
const int ip = ipiv_T[i] - 1; const blasint ip = ipiv_T[i] - 1;
if (ip != i) { if (ip != i) {
if (ip < *kl) if (ip < *kl)
BLAS(dswap)(&i, A_L + i, ldA, A_L + ip, ldA); BLAS(dswap)(&i, A_L + i, ldA, A_L + ip, ldA);

62
relapack/src/dgemmt.c
View File

@ -1,12 +1,12 @@
#include "relapack.h" #include "relapack.h"
static void RELAPACK_dgemmt_rec(const char *, const char *, const char *, static void RELAPACK_dgemmt_rec(const char *, const char *, const char *,
const int *, const int *, const double *, const double *, const int *, const blasint *, const blasint *, const double *, const double *, const blasint *,
const double *, const int *, const double *, double *, const int *); const double *, const blasint *, const double *, double *, const blasint *);
static void RELAPACK_dgemmt_rec2(const char *, const char *, const char *, static void RELAPACK_dgemmt_rec2(const char *, const char *, const char *,
const int *, const int *, const double *, const double *, const int *, const blasint *, const blasint *, const double *, const double *, const blasint *,
const double *, const int *, const double *, double *, const int *); const double *, const blasint *, const double *, double *, const blasint *);
/** DGEMMT computes a matrix-matrix product with general matrices but updates /** DGEMMT computes a matrix-matrix product with general matrices but updates
@ -20,10 +20,10 @@ static void RELAPACK_dgemmt_rec2(const char *, const char *, const char *,
* */ * */
void RELAPACK_dgemmt( void RELAPACK_dgemmt(
const char *uplo, const char *transA, const char *transB, const char *uplo, const char *transA, const char *transB,
const int *n, const int *k, const blasint *n, const blasint *k,
const double *alpha, const double *A, const int *ldA, const double *alpha, const double *A, const blasint *ldA,
const double *B, const int *ldB, const double *B, const blasint *ldB,
const double *beta, double *C, const int *ldC const double *beta, double *C, const blasint *ldC
) { ) {
#if HAVE_XGEMMT #if HAVE_XGEMMT
@ -32,13 +32,13 @@ void RELAPACK_dgemmt(
#else #else
// Check arguments // Check arguments
const int lower = LAPACK(lsame)(uplo, "L"); const blasint lower = LAPACK(lsame)(uplo, "L");
const int upper = LAPACK(lsame)(uplo, "U"); const blasint upper = LAPACK(lsame)(uplo, "U");
const int notransA = LAPACK(lsame)(transA, "N"); const blasint notransA = LAPACK(lsame)(transA, "N");
const int tranA = LAPACK(lsame)(transA, "T"); const blasint tranA = LAPACK(lsame)(transA, "T");
const int notransB = LAPACK(lsame)(transB, "N"); const blasint notransB = LAPACK(lsame)(transB, "N");
const int tranB = LAPACK(lsame)(transB, "T"); const blasint tranB = LAPACK(lsame)(transB, "T");
int info = 0; blasint info = 0;
if (!lower && !upper) if (!lower && !upper)
info = 1; info = 1;
else if (!tranA && !notransA) else if (!tranA && !notransA)
@ -56,7 +56,7 @@ void RELAPACK_dgemmt(
else if (*ldC < MAX(1, *n)) else if (*ldC < MAX(1, *n))
info = 13; info = 13;
if (info) { if (info) {
LAPACK(xerbla)("DGEMMT", &info); LAPACK(xerbla)("DGEMMT", &info, strlen("DGEMMT"));
return; return;
} }
@ -74,10 +74,10 @@ void RELAPACK_dgemmt(
/** dgemmt's recursive compute kernel */ /** dgemmt's recursive compute kernel */
static void RELAPACK_dgemmt_rec( static void RELAPACK_dgemmt_rec(
const char *uplo, const char *transA, const char *transB, const char *uplo, const char *transA, const char *transB,
const int *n, const int *k, const blasint *n, const blasint *k,
const double *alpha, const double *A, const int *ldA, const double *alpha, const double *A, const blasint *ldA,
const double *B, const int *ldB, const double *B, const blasint *ldB,
const double *beta, double *C, const int *ldC const double *beta, double *C, const blasint *ldC
) { ) {
if (*n <= MAX(CROSSOVER_DGEMMT, 1)) { if (*n <= MAX(CROSSOVER_DGEMMT, 1)) {
@ -87,8 +87,8 @@ static void RELAPACK_dgemmt_rec(
} }
// Splitting // Splitting
const int n1 = DREC_SPLIT(*n); const blasint n1 = DREC_SPLIT(*n);
const int n2 = *n - n1; const blasint n2 = *n - n1;
// A_T // A_T
// A_B // A_B
@ -124,16 +124,16 @@ static void RELAPACK_dgemmt_rec(
/** dgemmt's unblocked compute kernel */ /** dgemmt's unblocked compute kernel */
static void RELAPACK_dgemmt_rec2( static void RELAPACK_dgemmt_rec2(
const char *uplo, const char *transA, const char *transB, const char *uplo, const char *transA, const char *transB,
const int *n, const int *k, const blasint *n, const blasint *k,
const double *alpha, const double *A, const int *ldA, const double *alpha, const double *A, const blasint *ldA,
const double *B, const int *ldB, const double *B, const blasint *ldB,
const double *beta, double *C, const int *ldC const double *beta, double *C, const blasint *ldC
) { ) {
const int incB = (*transB == 'N') ? 1 : *ldB; const blasint incB = (*transB == 'N') ? 1 : *ldB;
const int incC = 1; const blasint incC = 1;
int i; blasint i;
for (i = 0; i < *n; i++) { for (i = 0; i < *n; i++) {
// A_0 // A_0
// A_i // A_i
@ -149,13 +149,13 @@ static void RELAPACK_dgemmt_rec2(
double *const C_ii = C + *ldC * i + i; double *const C_ii = C + *ldC * i + i;
if (*uplo == 'L') { if (*uplo == 'L') {
const int nmi = *n - i; const blasint nmi = *n - i;
if (*transA == 'N') if (*transA == 'N')
BLAS(dgemv)(transA, &nmi, k, alpha, A_i, ldA, B_i, &incB, beta, C_ii, &incC); BLAS(dgemv)(transA, &nmi, k, alpha, A_i, ldA, B_i, &incB, beta, C_ii, &incC);
else else
BLAS(dgemv)(transA, k, &nmi, alpha, A_i, ldA, B_i, &incB, beta, C_ii, &incC); BLAS(dgemv)(transA, k, &nmi, alpha, A_i, ldA, B_i, &incB, beta, C_ii, &incC);
} else { } else {
const int ip1 = i + 1; const blasint ip1 = i + 1;
if (*transA == 'N') if (*transA == 'N')
BLAS(dgemv)(transA, &ip1, k, alpha, A_0, ldA, B_i, &incB, beta, C_0i, &incC); BLAS(dgemv)(transA, &ip1, k, alpha, A_0, ldA, B_i, &incB, beta, C_0i, &incC);
else else

40
relapack/src/dgetrf.c
View File

@ -1,7 +1,7 @@
#include "relapack.h" #include "relapack.h"
static void RELAPACK_dgetrf_rec(const int *, const int *, double *, static void RELAPACK_dgetrf_rec(const blasint *, const blasint *, double *,
const int *, int *, int *); const blasint *, blasint *, blasint *);
/** DGETRF computes an LU factorization of a general M-by-N matrix A using partial pivoting with row interchanges. /** DGETRF computes an LU factorization of a general M-by-N matrix A using partial pivoting with row interchanges.
@ -11,9 +11,9 @@ static void RELAPACK_dgetrf_rec(const int *, const int *, double *,
* http://www.netlib.org/lapack/explore-html/d3/d6a/dgetrf_8f.html * http://www.netlib.org/lapack/explore-html/d3/d6a/dgetrf_8f.html
* */ * */
void RELAPACK_dgetrf( void RELAPACK_dgetrf(
const int *m, const int *n, const blasint *m, const blasint *n,
double *A, const int *ldA, int *ipiv, double *A, const blasint *ldA, blasint *ipiv,
int *info blasint *info
) { ) {
// Check arguments // Check arguments
@ -25,12 +25,12 @@ void RELAPACK_dgetrf(
else if (*ldA < MAX(1, *n)) else if (*ldA < MAX(1, *n))
*info = -4; *info = -4;
if (*info) { if (*info) {
const int minfo = -*info; const blasint minfo = -*info;
LAPACK(xerbla)("DGETRF", &minfo); LAPACK(xerbla)("DGETRF", &minfo, strlen("DGETRF"));
return; return;
} }
const int sn = MIN(*m, *n); const blasint sn = MIN(*m, *n);
RELAPACK_dgetrf_rec(m, &sn, A, ldA, ipiv, info); RELAPACK_dgetrf_rec(m, &sn, A, ldA, ipiv, info);
@ -38,10 +38,10 @@ void RELAPACK_dgetrf(
if (*m < *n) { if (*m < *n) {
// Constants // Constants
const double ONE[] = { 1. }; const double ONE[] = { 1. };
const int iONE[] = { 1. }; const blasint iONE[] = { 1. };
// Splitting // Splitting
const int rn = *n - *m; const blasint rn = *n - *m;
// A_L A_R // A_L A_R
const double *const A_L = A; const double *const A_L = A;
@ -57,9 +57,9 @@ void RELAPACK_dgetrf(
/** dgetrf's recursive compute kernel */ /** dgetrf's recursive compute kernel */
static void RELAPACK_dgetrf_rec( static void RELAPACK_dgetrf_rec(
const int *m, const int *n, const blasint *m, const blasint *n,
double *A, const int *ldA, int *ipiv, double *A, const blasint *ldA, blasint *ipiv,
int *info blasint *info
) { ) {
if (*n <= MAX(CROSSOVER_DGETRF, 1)) { if (*n <= MAX(CROSSOVER_DGETRF, 1)) {
@ -71,12 +71,12 @@ static void RELAPACK_dgetrf_rec(
// Constants // Constants
const double ONE[] = { 1. }; const double ONE[] = { 1. };
const double MONE[] = { -1. }; const double MONE[] = { -1. };
const int iONE[] = { 1 }; const blasint iONE[] = { 1 };
// Splitting // Splitting
const int n1 = DREC_SPLIT(*n); const blasint n1 = DREC_SPLIT(*n);
const int n2 = *n - n1; const blasint n2 = *n - n1;
const int m2 = *m - n1; const blasint m2 = *m - n1;
// A_L A_R // A_L A_R
double *const A_L = A; double *const A_L = A;
@ -91,8 +91,8 @@ static void RELAPACK_dgetrf_rec(
// ipiv_T // ipiv_T
// ipiv_B // ipiv_B
int *const ipiv_T = ipiv; blasint *const ipiv_T = ipiv;
int *const ipiv_B = ipiv + n1; blasint *const ipiv_B = ipiv + n1;
// recursion(A_L, ipiv_T) // recursion(A_L, ipiv_T)
RELAPACK_dgetrf_rec(m, &n1, A_L, ldA, ipiv_T, info); RELAPACK_dgetrf_rec(m, &n1, A_L, ldA, ipiv_T, info);
@ -111,7 +111,7 @@ static void RELAPACK_dgetrf_rec(
// apply pivots to A_BL // apply pivots to A_BL
LAPACK(dlaswp)(&n1, A_BL, ldA, iONE, &n2, ipiv_B, iONE); LAPACK(dlaswp)(&n1, A_BL, ldA, iONE, &n2, ipiv_B, iONE);
// shift pivots // shift pivots
int i; blasint i;
for (i = 0; i < n2; i++) for (i = 0; i < n2; i++)
ipiv_B[i] += n1; ipiv_B[i] += n1;
} }

28
relapack/src/dlauum.c
View File

@ -1,7 +1,7 @@
#include "relapack.h" #include "relapack.h"
static void RELAPACK_dlauum_rec(const char *, const int *, double *, static void RELAPACK_dlauum_rec(const char *, const blasint *, double *,
const int *, int *); const blasint *, blasint *);
/** DLAUUM computes the product U * U**T or L**T * L, where the triangular factor U or L is stored in the upper or lower triangular part of the array A. /** DLAUUM computes the product U * U**T or L**T * L, where the triangular factor U or L is stored in the upper or lower triangular part of the array A.
@ -11,14 +11,14 @@ static void RELAPACK_dlauum_rec(const char *, const int *, double *,
* http://www.netlib.org/lapack/explore-html/d0/dc2/dlauum_8f.html * http://www.netlib.org/lapack/explore-html/d0/dc2/dlauum_8f.html
* */ * */
void RELAPACK_dlauum( void RELAPACK_dlauum(
const char *uplo, const int *n, const char *uplo, const blasint *n,
double *A, const int *ldA, double *A, const blasint *ldA,
int *info blasint *info
) { ) {
// Check arguments // Check arguments
const int lower = LAPACK(lsame)(uplo, "L"); const blasint lower = LAPACK(lsame)(uplo, "L");
const int upper = LAPACK(lsame)(uplo, "U"); const blasint upper = LAPACK(lsame)(uplo, "U");
*info = 0; *info = 0;
if (!lower && !upper) if (!lower && !upper)
*info = -1; *info = -1;
@ -27,8 +27,8 @@ void RELAPACK_dlauum(
else if (*ldA < MAX(1, *n)) else if (*ldA < MAX(1, *n))
*info = -4; *info = -4;
if (*info) { if (*info) {
const int minfo = -*info; const blasint minfo = -*info;
LAPACK(xerbla)("DLAUUM", &minfo); LAPACK(xerbla)("DLAUUM", &minfo, strlen("DLAUUM"));
return; return;
} }
@ -42,9 +42,9 @@ void RELAPACK_dlauum(
/** dlauum's recursive compute kernel */ /** dlauum's recursive compute kernel */
static void RELAPACK_dlauum_rec( static void RELAPACK_dlauum_rec(
const char *uplo, const int *n, const char *uplo, const blasint *n,
double *A, const int *ldA, double *A, const blasint *ldA,
int *info blasint *info
) { ) {
if (*n <= MAX(CROSSOVER_DLAUUM, 1)) { if (*n <= MAX(CROSSOVER_DLAUUM, 1)) {
@ -57,8 +57,8 @@ static void RELAPACK_dlauum_rec(
const double ONE[] = { 1. }; const double ONE[] = { 1. };
// Splitting // Splitting
const int n1 = DREC_SPLIT(*n); const blasint n1 = DREC_SPLIT(*n);
const int n2 = *n - n1; const blasint n2 = *n - n1;
// A_TL A_TR // A_TL A_TR
// A_BL A_BR // A_BL A_BR

42
relapack/src/dpbtrf.c
View File

@ -1,8 +1,8 @@
#include "relapack.h" #include "relapack.h"
#include "stdlib.h" #include "stdlib.h"
static void RELAPACK_dpbtrf_rec(const char *, const int *, const int *, static void RELAPACK_dpbtrf_rec(const char *, const blasint *, const blasint *,
double *, const int *, double *, const int *, int *); double *, const blasint *, double *, const blasint *, blasint *);
/** DPBTRF computes the Cholesky factorization of a real symmetric positive definite band matrix A. /** DPBTRF computes the Cholesky factorization of a real symmetric positive definite band matrix A.
@ -12,14 +12,14 @@ static void RELAPACK_dpbtrf_rec(const char *, const int *, const int *,
* http://www.netlib.org/lapack/explore-html/df/da9/dpbtrf_8f.html * http://www.netlib.org/lapack/explore-html/df/da9/dpbtrf_8f.html
* */ * */
void RELAPACK_dpbtrf( void RELAPACK_dpbtrf(
const char *uplo, const int *n, const int *kd, const char *uplo, const blasint *n, const blasint *kd,
double *Ab, const int *ldAb, double *Ab, const blasint *ldAb,
int *info blasint *info
) { ) {
// Check arguments // Check arguments
const int lower = LAPACK(lsame)(uplo, "L"); const blasint lower = LAPACK(lsame)(uplo, "L");
const int upper = LAPACK(lsame)(uplo, "U"); const blasint upper = LAPACK(lsame)(uplo, "U");
*info = 0; *info = 0;
if (!lower && !upper) if (!lower && !upper)
*info = -1; *info = -1;
@ -30,8 +30,8 @@ void RELAPACK_dpbtrf(
else if (*ldAb < *kd + 1) else if (*ldAb < *kd + 1)
*info = -5; *info = -5;
if (*info) { if (*info) {
const int minfo = -*info; const blasint minfo = -*info;
LAPACK(xerbla)("DPBTRF", &minfo); LAPACK(xerbla)("DPBTRF", &minfo, strlen("DPBTRF"));
return; return;
} }
@ -42,9 +42,9 @@ void RELAPACK_dpbtrf(
const double ZERO[] = { 0. }; const double ZERO[] = { 0. };
// Allocate work space // Allocate work space
const int n1 = DREC_SPLIT(*n); const blasint n1 = DREC_SPLIT(*n);
const int mWork = (*kd > n1) ? (lower ? *n - *kd : n1) : *kd; const blasint mWork = (*kd > n1) ? (lower ? *n - *kd : n1) : *kd;
const int nWork = (*kd > n1) ? (lower ? n1 : *n - *kd) : *kd; const blasint nWork = (*kd > n1) ? (lower ? n1 : *n - *kd) : *kd;
double *Work = malloc(mWork * nWork * sizeof(double)); double *Work = malloc(mWork * nWork * sizeof(double));
LAPACK(dlaset)(uplo, &mWork, &nWork, ZERO, ZERO, Work, &mWork); LAPACK(dlaset)(uplo, &mWork, &nWork, ZERO, ZERO, Work, &mWork);
@ -58,10 +58,10 @@ void RELAPACK_dpbtrf(
/** dpbtrf's recursive compute kernel */ /** dpbtrf's recursive compute kernel */
static void RELAPACK_dpbtrf_rec( static void RELAPACK_dpbtrf_rec(
const char *uplo, const int *n, const int *kd, const char *uplo, const blasint *n, const blasint *kd,
double *Ab, const int *ldAb, double *Ab, const blasint *ldAb,
double *Work, const int *ldWork, double *Work, const blasint *ldWork,
int *info blasint *info
){ ){
if (*n <= MAX(CROSSOVER_DPBTRF, 1)) { if (*n <= MAX(CROSSOVER_DPBTRF, 1)) {
@ -75,12 +75,12 @@ static void RELAPACK_dpbtrf_rec(
const double MONE[] = { -1. }; const double MONE[] = { -1. };
// Unskew A // Unskew A
const int ldA[] = { *ldAb - 1 }; const blasint ldA[] = { *ldAb - 1 };
double *const A = Ab + ((*uplo == 'L') ? 0 : *kd); double *const A = Ab + ((*uplo == 'L') ? 0 : *kd);
// Splitting // Splitting
const int n1 = MIN(DREC_SPLIT(*n), *kd); const blasint n1 = MIN(DREC_SPLIT(*n), *kd);
const int n2 = *n - n1; const blasint n2 = *n - n1;
// * * // * *
// * Ab_BR // * Ab_BR
@ -99,8 +99,8 @@ static void RELAPACK_dpbtrf_rec(
return; return;
// Banded splitting // Banded splitting
const int n21 = MIN(n2, *kd - n1); const blasint n21 = MIN(n2, *kd - n1);
const int n22 = MIN(n2 - n21, n1); const blasint n22 = MIN(n2 - n21, n1);
// n1 n21 n22 // n1 n21 n22
// n1 * A_TRl A_TRr // n1 * A_TRl A_TRr

28
relapack/src/dpotrf.c
View File

@ -1,7 +1,7 @@
#include "relapack.h" #include "relapack.h"
static void RELAPACK_dpotrf_rec(const char *, const int *, double *, static void RELAPACK_dpotrf_rec(const char *, const blasint *, double *,
const int *, int *); const blasint *, blasint *);
/** DPOTRF computes the Cholesky factorization of a real symmetric positive definite matrix A. /** DPOTRF computes the Cholesky factorization of a real symmetric positive definite matrix A.
@ -11,14 +11,14 @@ static void RELAPACK_dpotrf_rec(const char *, const int *, double *,
* http://www.netlib.org/lapack/explore-html/d0/d8a/dpotrf_8f.html * http://www.netlib.org/lapack/explore-html/d0/d8a/dpotrf_8f.html
* */ * */
void RELAPACK_dpotrf( void RELAPACK_dpotrf(
const char *uplo, const int *n, const char *uplo, const blasint *n,
double *A, const int *ldA, double *A, const blasint *ldA,
int *info blasint *info
) { ) {
// Check arguments // Check arguments
const int lower = LAPACK(lsame)(uplo, "L"); const blasint lower = LAPACK(lsame)(uplo, "L");
const int upper = LAPACK(lsame)(uplo, "U"); const blasint upper = LAPACK(lsame)(uplo, "U");
*info = 0; *info = 0;
if (!lower && !upper) if (!lower && !upper)
*info = -1; *info = -1;
@ -27,8 +27,8 @@ void RELAPACK_dpotrf(
else if (*ldA < MAX(1, *n)) else if (*ldA < MAX(1, *n))
*info = -4; *info = -4;
if (*info) { if (*info) {
const int minfo = -*info; const blasint minfo = -*info;
LAPACK(xerbla)("DPOTRF", &minfo); LAPACK(xerbla)("DPOTRF", &minfo, strlen("DPOTRF"));
return; return;
} }
@ -42,9 +42,9 @@ void RELAPACK_dpotrf(
/** dpotrf's recursive compute kernel */ /** dpotrf's recursive compute kernel */
static void RELAPACK_dpotrf_rec( static void RELAPACK_dpotrf_rec(
const char *uplo, const int *n, const char *uplo, const blasint *n,
double *A, const int *ldA, double *A, const blasint *ldA,
int *info blasint *info
){ ){
if (*n <= MAX(CROSSOVER_DPOTRF, 1)) { if (*n <= MAX(CROSSOVER_DPOTRF, 1)) {
@ -58,8 +58,8 @@ static void RELAPACK_dpotrf_rec(
const double MONE[] = { -1. }; const double MONE[] = { -1. };
// Splitting // Splitting
const int n1 = DREC_SPLIT(*n); const blasint n1 = DREC_SPLIT(*n);
const int n2 = *n - n1; const blasint n2 = *n - n1;
// A_TL A_TR // A_TL A_TR
// A_BL A_BR // A_BL A_BR

40
relapack/src/dsygst.c
View File

@ -3,9 +3,9 @@
#include "stdlib.h" #include "stdlib.h"
#endif #endif
static void RELAPACK_dsygst_rec(const int *, const char *, const int *, static void RELAPACK_dsygst_rec(const blasint *, const char *, const blasint *,
double *, const int *, const double *, const int *, double *, const blasint *, const double *, const blasint *,
double *, const int *, int *); double *, const blasint *, blasint *);
/** DSYGST reduces a real symmetric-definite generalized eigenproblem to standard form. /** DSYGST reduces a real symmetric-definite generalized eigenproblem to standard form.
@ -15,14 +15,14 @@ static void RELAPACK_dsygst_rec(const int *, const char *, const int *,
* http://www.netlib.org/lapack/explore-html/dc/d04/dsygst_8f.html * http://www.netlib.org/lapack/explore-html/dc/d04/dsygst_8f.html
* */ * */
void RELAPACK_dsygst( void RELAPACK_dsygst(
const int *itype, const char *uplo, const int *n, const blasint *itype, const char *uplo, const blasint *n,
double *A, const int *ldA, const double *B, const int *ldB, double *A, const blasint *ldA, const double *B, const blasint *ldB,
int *info blasint *info
) { ) {
// Check arguments // Check arguments
const int lower = LAPACK(lsame)(uplo, "L"); const blasint lower = LAPACK(lsame)(uplo, "L");
const int upper = LAPACK(lsame)(uplo, "U"); const blasint upper = LAPACK(lsame)(uplo, "U");
*info = 0; *info = 0;
if (*itype < 1 || *itype > 3) if (*itype < 1 || *itype > 3)
*info = -1; *info = -1;
@ -35,8 +35,8 @@ void RELAPACK_dsygst(
else if (*ldB < MAX(1, *n)) else if (*ldB < MAX(1, *n))
*info = -7; *info = -7;
if (*info) { if (*info) {
const int minfo = -*info; const blasint minfo = -*info;
LAPACK(xerbla)("DSYGST", &minfo); LAPACK(xerbla)("DSYGST", &minfo, strlen("DSYGST"));
return; return;
} }
@ -45,10 +45,10 @@ void RELAPACK_dsygst(
// Allocate work space // Allocate work space
double *Work = NULL; double *Work = NULL;
int lWork = 0; blasint lWork = 0;
#if XSYGST_ALLOW_MALLOC #if XSYGST_ALLOW_MALLOC
const int n1 = DREC_SPLIT(*n); const blasint n1 = DREC_SPLIT(*n);
lWork = n1 * (*n - n1); lWork = abs( n1 * (*n - n1) );
Work = malloc(lWork * sizeof(double)); Work = malloc(lWork * sizeof(double));
if (!Work) if (!Work)
lWork = 0; lWork = 0;
@ -67,9 +67,9 @@ void RELAPACK_dsygst(
/** dsygst's recursive compute kernel */ /** dsygst's recursive compute kernel */
static void RELAPACK_dsygst_rec( static void RELAPACK_dsygst_rec(
const int *itype, const char *uplo, const int *n, const blasint *itype, const char *uplo, const blasint *n,
double *A, const int *ldA, const double *B, const int *ldB, double *A, const blasint *ldA, const double *B, const blasint *ldB,
double *Work, const int *lWork, int *info double *Work, const blasint *lWork, blasint *info
) { ) {
if (*n <= MAX(CROSSOVER_SSYGST, 1)) { if (*n <= MAX(CROSSOVER_SSYGST, 1)) {
@ -84,14 +84,14 @@ static void RELAPACK_dsygst_rec(
const double MONE[] = { -1. }; const double MONE[] = { -1. };
const double HALF[] = { .5 }; const double HALF[] = { .5 };
const double MHALF[] = { -.5 }; const double MHALF[] = { -.5 };
const int iONE[] = { 1 }; const blasint iONE[] = { 1 };
// Loop iterator // Loop iterator
int i; blasint i;
// Splitting // Splitting
const int n1 = DREC_SPLIT(*n); const blasint n1 = DREC_SPLIT(*n);
const int n2 = *n - n1; const blasint n2 = *n - n1;
// A_TL A_TR // A_TL A_TR
// A_BL A_BR // A_BL A_BR

72
relapack/src/dsytrf.c
View File

@ -3,8 +3,8 @@
#include <stdlib.h> #include <stdlib.h>
#endif #endif
static void RELAPACK_dsytrf_rec(const char *, const int *, const int *, int *, static void RELAPACK_dsytrf_rec(const char *, const blasint *, const blasint *, blasint *,
double *, const int *, int *, double *, const int *, int *); double *, const blasint *, blasint *, double *, const blasint *, blasint *);
/** DSYTRF computes the factorization of a complex symmetric matrix A using the Bunch-Kaufman diagonal pivoting method. /** DSYTRF computes the factorization of a complex symmetric matrix A using the Bunch-Kaufman diagonal pivoting method.
@ -14,21 +14,21 @@ static void RELAPACK_dsytrf_rec(const char *, const int *, const int *, int *,
* http://www.netlib.org/lapack/explore-html/dd/df4/dsytrf_8f.html * http://www.netlib.org/lapack/explore-html/dd/df4/dsytrf_8f.html
* */ * */
void RELAPACK_dsytrf( void RELAPACK_dsytrf(
const char *uplo, const int *n, const char *uplo, const blasint *n,
double *A, const int *ldA, int *ipiv, double *A, const blasint *ldA, blasint *ipiv,
double *Work, const int *lWork, int *info double *Work, const blasint *lWork, blasint *info
) { ) {
// Required work size // Required work size
const int cleanlWork = *n * (*n / 2); const blasint cleanlWork = *n * (*n / 2);
int minlWork = cleanlWork; blasint minlWork = cleanlWork;
#if XSYTRF_ALLOW_MALLOC #if XSYTRF_ALLOW_MALLOC
minlWork = 1; minlWork = 1;
#endif #endif
// Check arguments // Check arguments
const int lower = LAPACK(lsame)(uplo, "L"); const blasint lower = LAPACK(lsame)(uplo, "L");
const int upper = LAPACK(lsame)(uplo, "U"); const blasint upper = LAPACK(lsame)(uplo, "U");
*info = 0; *info = 0;
if (!lower && !upper) if (!lower && !upper)
*info = -1; *info = -1;
@ -55,8 +55,8 @@ void RELAPACK_dsytrf(
#endif #endif
if (*info) { if (*info) {
const int minfo = -*info; const blasint minfo = -*info;
LAPACK(xerbla)("DSYTRF", &minfo); LAPACK(xerbla)("DSYTRF", &minfo, strlen("DSYTRF"));
return; return;
} }
@ -64,7 +64,7 @@ void RELAPACK_dsytrf(
const char cleanuplo = lower ? 'L' : 'U'; const char cleanuplo = lower ? 'L' : 'U';
// Dummy arguments // Dummy arguments
int nout; blasint nout;
// Recursive kernel // Recursive kernel
RELAPACK_dsytrf_rec(&cleanuplo, n, n, &nout, A, ldA, ipiv, cleanWork, n, info); RELAPACK_dsytrf_rec(&cleanuplo, n, n, &nout, A, ldA, ipiv, cleanWork, n, info);
@ -78,13 +78,13 @@ void RELAPACK_dsytrf(
/** dsytrf's recursive compute kernel */ /** dsytrf's recursive compute kernel */
static void RELAPACK_dsytrf_rec( static void RELAPACK_dsytrf_rec(
const char *uplo, const int *n_full, const int *n, int *n_out, const char *uplo, const blasint *n_full, const blasint *n, blasint *n_out,
double *A, const int *ldA, int *ipiv, double *A, const blasint *ldA, blasint *ipiv,
double *Work, const int *ldWork, int *info double *Work, const blasint *ldWork, blasint *info
) { ) {
// top recursion level? // top recursion level?
const int top = *n_full == *n; const blasint top = *n_full == *n;
if (*n <= MAX(CROSSOVER_DSYTRF, 3)) { if (*n <= MAX(CROSSOVER_DSYTRF, 3)) {
// Unblocked // Unblocked
@ -96,34 +96,34 @@ static void RELAPACK_dsytrf_rec(
return; return;
} }
int info1, info2; blasint info1, info2;
// Constants // Constants
const double ONE[] = { 1. }; const double ONE[] = { 1. };
const double MONE[] = { -1. }; const double MONE[] = { -1. };
const int iONE[] = { 1 }; const blasint iONE[] = { 1 };
// Loop iterator // Loop iterator
int i; blasint i;
const int n_rest = *n_full - *n; const blasint n_rest = *n_full - *n;
if (*uplo == 'L') { if (*uplo == 'L') {
// Splitting (setup) // Splitting (setup)
int n1 = DREC_SPLIT(*n); blasint n1 = DREC_SPLIT(*n);
int n2 = *n - n1; blasint n2 = *n - n1;
// Work_L * // Work_L *
double *const Work_L = Work; double *const Work_L = Work;
// recursion(A_L) // recursion(A_L)
int n1_out; blasint n1_out;
RELAPACK_dsytrf_rec(uplo, n_full, &n1, &n1_out, A, ldA, ipiv, Work_L, ldWork, &info1); RELAPACK_dsytrf_rec(uplo, n_full, &n1, &n1_out, A, ldA, ipiv, Work_L, ldWork, &info1);
n1 = n1_out; n1 = n1_out;
// Splitting (continued) // Splitting (continued)
n2 = *n - n1; n2 = *n - n1;
const int n_full2 = *n_full - n1; const blasint n_full2 = *n_full - n1;
// * * // * *
// A_BL A_BR // A_BL A_BR
@ -139,23 +139,23 @@ static void RELAPACK_dsytrf_rec(
// (top recursion level: use Work as Work_BR) // (top recursion level: use Work as Work_BR)
double *const Work_BL = Work + n1; double *const Work_BL = Work + n1;
double *const Work_BR = top ? Work : Work + *ldWork * n1 + n1; double *const Work_BR = top ? Work : Work + *ldWork * n1 + n1;
const int ldWork_BR = top ? n2 : *ldWork; const blasint ldWork_BR = top ? n2 : *ldWork;
// ipiv_T // ipiv_T
// ipiv_B // ipiv_B
int *const ipiv_B = ipiv + n1; blasint *const ipiv_B = ipiv + n1;
// A_BR = A_BR - A_BL Work_BL' // A_BR = A_BR - A_BL Work_BL'
RELAPACK_dgemmt(uplo, "N", "T", &n2, &n1, MONE, A_BL, ldA, Work_BL, ldWork, ONE, A_BR, ldA); RELAPACK_dgemmt(uplo, "N", "T", &n2, &n1, MONE, A_BL, ldA, Work_BL, ldWork, ONE, A_BR, ldA);
BLAS(dgemm)("N", "T", &n_rest, &n2, &n1, MONE, A_BL_B, ldA, Work_BL, ldWork, ONE, A_BR_B, ldA); BLAS(dgemm)("N", "T", &n_rest, &n2, &n1, MONE, A_BL_B, ldA, Work_BL, ldWork, ONE, A_BR_B, ldA);
// recursion(A_BR) // recursion(A_BR)
int n2_out; blasint n2_out;
RELAPACK_dsytrf_rec(uplo, &n_full2, &n2, &n2_out, A_BR, ldA, ipiv_B, Work_BR, &ldWork_BR, &info2); RELAPACK_dsytrf_rec(uplo, &n_full2, &n2, &n2_out, A_BR, ldA, ipiv_B, Work_BR, &ldWork_BR, &info2);
if (n2_out != n2) { if (n2_out != n2) {
// undo 1 column of updates // undo 1 column of updates
const int n_restp1 = n_rest + 1; const blasint n_restp1 = n_rest + 1;
// last column of A_BR // last column of A_BR
double *const A_BR_r = A_BR + *ldA * n2_out + n2_out; double *const A_BR_r = A_BR + *ldA * n2_out + n2_out;
@ -182,22 +182,22 @@ static void RELAPACK_dsytrf_rec(
*n_out = n1 + n2; *n_out = n1 + n2;
} else { } else {
// Splitting (setup) // Splitting (setup)
int n2 = DREC_SPLIT(*n); blasint n2 = DREC_SPLIT(*n);
int n1 = *n - n2; blasint n1 = *n - n2;
// * Work_R // * Work_R
// (top recursion level: use Work as Work_R) // (top recursion level: use Work as Work_R)
double *const Work_R = top ? Work : Work + *ldWork * n1; double *const Work_R = top ? Work : Work + *ldWork * n1;
// recursion(A_R) // recursion(A_R)
int n2_out; blasint n2_out;
RELAPACK_dsytrf_rec(uplo, n_full, &n2, &n2_out, A, ldA, ipiv, Work_R, ldWork, &info2); RELAPACK_dsytrf_rec(uplo, n_full, &n2, &n2_out, A, ldA, ipiv, Work_R, ldWork, &info2);
const int n2_diff = n2 - n2_out; const blasint n2_diff = n2 - n2_out;
n2 = n2_out; n2 = n2_out;
// Splitting (continued) // Splitting (continued)
n1 = *n - n2; n1 = *n - n2;
const int n_full1 = *n_full - n2; const blasint n_full1 = *n_full - n2;
// * A_TL_T A_TR_T // * A_TL_T A_TR_T
// * A_TL A_TR // * A_TL A_TR
@ -213,19 +213,19 @@ static void RELAPACK_dsytrf_rec(
// (top recursion level: Work_R was Work) // (top recursion level: Work_R was Work)
double *const Work_L = Work; double *const Work_L = Work;
double *const Work_TR = Work + *ldWork * (top ? n2_diff : n1) + n_rest; double *const Work_TR = Work + *ldWork * (top ? n2_diff : n1) + n_rest;
const int ldWork_L = top ? n1 : *ldWork; const blasint ldWork_L = top ? n1 : *ldWork;
// A_TL = A_TL - A_TR Work_TR' // A_TL = A_TL - A_TR Work_TR'
RELAPACK_dgemmt(uplo, "N", "T", &n1, &n2, MONE, A_TR, ldA, Work_TR, ldWork, ONE, A_TL, ldA); RELAPACK_dgemmt(uplo, "N", "T", &n1, &n2, MONE, A_TR, ldA, Work_TR, ldWork, ONE, A_TL, ldA);
BLAS(dgemm)("N", "T", &n_rest, &n1, &n2, MONE, A_TR_T, ldA, Work_TR, ldWork, ONE, A_TL_T, ldA); BLAS(dgemm)("N", "T", &n_rest, &n1, &n2, MONE, A_TR_T, ldA, Work_TR, ldWork, ONE, A_TL_T, ldA);
// recursion(A_TL) // recursion(A_TL)
int n1_out; blasint n1_out;
RELAPACK_dsytrf_rec(uplo, &n_full1, &n1, &n1_out, A, ldA, ipiv, Work_L, &ldWork_L, &info1); RELAPACK_dsytrf_rec(uplo, &n_full1, &n1, &n1_out, A, ldA, ipiv, Work_L, &ldWork_L, &info1);
if (n1_out != n1) { if (n1_out != n1) {
// undo 1 column of updates // undo 1 column of updates
const int n_restp1 = n_rest + 1; const blasint n_restp1 = n_rest + 1;
// A_TL_T_l = A_TL_T_l + A_TR_T Work_TR_t' // A_TL_T_l = A_TL_T_l + A_TR_T Work_TR_t'
BLAS(dgemv)("N", &n_restp1, &n2, ONE, A_TR_T, ldA, Work_TR, ldWork, ONE, A_TL_T, iONE); BLAS(dgemv)("N", &n_restp1, &n2, ONE, A_TR_T, ldA, Work_TR, ldWork, ONE, A_TL_T, iONE);

32
relapack/src/dsytrf_rec2.c
View File

@ -14,7 +14,7 @@
/* Table of constant values */ /* Table of constant values */
static int c__1 = 1; static blasint c__1 = 1;
static double c_b8 = -1.; static double c_b8 = -1.;
static double c_b9 = 1.; static double c_b9 = 1.;
@ -25,33 +25,33 @@ static double c_b9 = 1.;
* The blocked BLAS Level 3 updates were removed and moved to the * The blocked BLAS Level 3 updates were removed and moved to the
* recursive algorithm. * recursive algorithm.
* */ * */
/* Subroutine */ void RELAPACK_dsytrf_rec2(char *uplo, int *n, int * /* Subroutine */ void RELAPACK_dsytrf_rec2(char *uplo, blasint *n, blasint *
nb, int *kb, double *a, int *lda, int *ipiv, nb, blasint *kb, double *a, blasint *lda, blasint *ipiv,
double *w, int *ldw, int *info, ftnlen uplo_len) double *w, blasint *ldw, blasint *info, ftnlen uplo_len)
{ {
/* System generated locals */ /* System generated locals */
int a_dim1, a_offset, w_dim1, w_offset, i__1, i__2; blasint a_dim1, a_offset, w_dim1, w_offset, i__1, i__2;
double d__1, d__2, d__3; double d__1, d__2, d__3;
/* Builtin functions */ /* Builtin functions */
double sqrt(double); double sqrt(double);
/* Local variables */ /* Local variables */
static int j, k; static blasint j, k;
static double t, r1, d11, d21, d22; static double t, r1, d11, d21, d22;
static int jj, kk, jp, kp, kw, kkw, imax, jmax; static blasint jj, kk, jp, kp, kw, kkw, imax, jmax;
static double alpha; static double alpha;
extern /* Subroutine */ int dscal_(int *, double *, double *, extern /* Subroutine */ blasint dscal_(int *, double *, double *,
int *); blasint *);
extern logical lsame_(char *, char *, ftnlen, ftnlen); extern logical lsame_(char *, char *, ftnlen, ftnlen);
extern /* Subroutine */ int dgemv_(char *, int *, int *, extern /* Subroutine */ blasint dgemv_(char *, blasint *, blasint *,
double *, double *, int *, double *, int *, double *, double *, blasint *, double *, blasint *,
double *, double *, int *, ftnlen), dcopy_(int *, double *, double *, blasint *, ftnlen), dcopy_(int *,
double *, int *, double *, int *), dswap_(int double *, blasint *, double *, blasint *), dswap_(int
*, double *, int *, double *, int *); *, double *, blasint *, double *, blasint *);
static int kstep; static blasint kstep;
static double absakk; static double absakk;
extern int idamax_(int *, double *, int *); extern blasint idamax_(int *, double *, blasint *);
static double colmax, rowmax; static double colmax, rowmax;
/* Parameter adjustments */ /* Parameter adjustments */

72
relapack/src/dsytrf_rook.c
View File

@ -3,8 +3,8 @@
#include <stdlib.h> #include <stdlib.h>
#endif #endif
static void RELAPACK_dsytrf_rook_rec(const char *, const int *, const int *, int *, static void RELAPACK_dsytrf_rook_rec(const char *, const blasint *, const blasint *, blasint *,
double *, const int *, int *, double *, const int *, int *); double *, const blasint *, blasint *, double *, const blasint *, blasint *);
/** DSYTRF_ROOK computes the factorization of a real symmetric matrix A using the bounded Bunch-Kaufman ("rook") diagonal pivoting method. /** DSYTRF_ROOK computes the factorization of a real symmetric matrix A using the bounded Bunch-Kaufman ("rook") diagonal pivoting method.
@ -14,21 +14,21 @@ static void RELAPACK_dsytrf_rook_rec(const char *, const int *, const int *, int
* http://www.netlib.org/lapack/explore-html/db/df4/dsytrf__rook_8f.html * http://www.netlib.org/lapack/explore-html/db/df4/dsytrf__rook_8f.html
* */ * */
void RELAPACK_dsytrf_rook( void RELAPACK_dsytrf_rook(
const char *uplo, const int *n, const char *uplo, const blasint *n,
double *A, const int *ldA, int *ipiv, double *A, const blasint *ldA, blasint *ipiv,
double *Work, const int *lWork, int *info double *Work, const blasint *lWork, blasint *info
) { ) {
// Required work size // Required work size
const int cleanlWork = *n * (*n / 2); const blasint cleanlWork = *n * (*n / 2);
int minlWork = cleanlWork; blasint minlWork = cleanlWork;
#if XSYTRF_ALLOW_MALLOC #if XSYTRF_ALLOW_MALLOC
minlWork = 1; minlWork = 1;
#endif #endif
// Check arguments // Check arguments
const int lower = LAPACK(lsame)(uplo, "L"); const blasint lower = LAPACK(lsame)(uplo, "L");
const int upper = LAPACK(lsame)(uplo, "U"); const blasint upper = LAPACK(lsame)(uplo, "U");
*info = 0; *info = 0;
if (!lower && !upper) if (!lower && !upper)
*info = -1; *info = -1;
@ -55,8 +55,8 @@ void RELAPACK_dsytrf_rook(
#endif #endif
if (*info) { if (*info) {
const int minfo = -*info; const blasint minfo = -*info;
LAPACK(xerbla)("DSYTRF", &minfo); LAPACK(xerbla)("DSYTRF", &minfo, strlen("DSYTRF"));
return; return;
} }
@ -64,7 +64,7 @@ void RELAPACK_dsytrf_rook(
const char cleanuplo = lower ? 'L' : 'U'; const char cleanuplo = lower ? 'L' : 'U';
// Dummy argument // Dummy argument
int nout; blasint nout;
// Recursive kernel // Recursive kernel
RELAPACK_dsytrf_rook_rec(&cleanuplo, n, n, &nout, A, ldA, ipiv, cleanWork, n, info); RELAPACK_dsytrf_rook_rec(&cleanuplo, n, n, &nout, A, ldA, ipiv, cleanWork, n, info);
@ -78,13 +78,13 @@ void RELAPACK_dsytrf_rook(
/** dsytrf_rook's recursive compute kernel */ /** dsytrf_rook's recursive compute kernel */
static void RELAPACK_dsytrf_rook_rec( static void RELAPACK_dsytrf_rook_rec(
const char *uplo, const int *n_full, const int *n, int *n_out, const char *uplo, const blasint *n_full, const blasint *n, blasint *n_out,
double *A, const int *ldA, int *ipiv, double *A, const blasint *ldA, blasint *ipiv,
double *Work, const int *ldWork, int *info double *Work, const blasint *ldWork, blasint *info
) { ) {
// top recursion level? // top recursion level?
const int top = *n_full == *n; const blasint top = *n_full == *n;
if (*n <= MAX(CROSSOVER_DSYTRF_ROOK, 3)) { if (*n <= MAX(CROSSOVER_DSYTRF_ROOK, 3)) {
// Unblocked // Unblocked
@ -96,31 +96,31 @@ static void RELAPACK_dsytrf_rook_rec(
return; return;
} }
int info1, info2; blasint info1, info2;
// Constants // Constants
const double ONE[] = { 1. }; const double ONE[] = { 1. };
const double MONE[] = { -1. }; const double MONE[] = { -1. };
const int iONE[] = { 1 }; const blasint iONE[] = { 1 };
const int n_rest = *n_full - *n; const blasint n_rest = *n_full - *n;
if (*uplo == 'L') { if (*uplo == 'L') {
// Splitting (setup) // Splitting (setup)
int n1 = DREC_SPLIT(*n); blasint n1 = DREC_SPLIT(*n);
int n2 = *n - n1; blasint n2 = *n - n1;
// Work_L * // Work_L *
double *const Work_L = Work; double *const Work_L = Work;
// recursion(A_L) // recursion(A_L)
int n1_out; blasint n1_out;
RELAPACK_dsytrf_rook_rec(uplo, n_full, &n1, &n1_out, A, ldA, ipiv, Work_L, ldWork, &info1); RELAPACK_dsytrf_rook_rec(uplo, n_full, &n1, &n1_out, A, ldA, ipiv, Work_L, ldWork, &info1);
n1 = n1_out; n1 = n1_out;
// Splitting (continued) // Splitting (continued)
n2 = *n - n1; n2 = *n - n1;
const int n_full2 = *n_full - n1; const blasint n_full2 = *n_full - n1;
// * * // * *
// A_BL A_BR // A_BL A_BR
@ -136,23 +136,23 @@ static void RELAPACK_dsytrf_rook_rec(
// (top recursion level: use Work as Work_BR) // (top recursion level: use Work as Work_BR)
double *const Work_BL = Work + n1; double *const Work_BL = Work + n1;
double *const Work_BR = top ? Work : Work + *ldWork * n1 + n1; double *const Work_BR = top ? Work : Work + *ldWork * n1 + n1;
const int ldWork_BR = top ? n2 : *ldWork; const blasint ldWork_BR = top ? n2 : *ldWork;
// ipiv_T // ipiv_T
// ipiv_B // ipiv_B
int *const ipiv_B = ipiv + n1; blasint *const ipiv_B = ipiv + n1;
// A_BR = A_BR - A_BL Work_BL' // A_BR = A_BR - A_BL Work_BL'
RELAPACK_dgemmt(uplo, "N", "T", &n2, &n1, MONE, A_BL, ldA, Work_BL, ldWork, ONE, A_BR, ldA); RELAPACK_dgemmt(uplo, "N", "T", &n2, &n1, MONE, A_BL, ldA, Work_BL, ldWork, ONE, A_BR, ldA);
BLAS(dgemm)("N", "T", &n_rest, &n2, &n1, MONE, A_BL_B, ldA, Work_BL, ldWork, ONE, A_BR_B, ldA); BLAS(dgemm)("N", "T", &n_rest, &n2, &n1, MONE, A_BL_B, ldA, Work_BL, ldWork, ONE, A_BR_B, ldA);
// recursion(A_BR) // recursion(A_BR)
int n2_out; blasint n2_out;
RELAPACK_dsytrf_rook_rec(uplo, &n_full2, &n2, &n2_out, A_BR, ldA, ipiv_B, Work_BR, &ldWork_BR, &info2); RELAPACK_dsytrf_rook_rec(uplo, &n_full2, &n2, &n2_out, A_BR, ldA, ipiv_B, Work_BR, &ldWork_BR, &info2);
if (n2_out != n2) { if (n2_out != n2) {
// undo 1 column of updates // undo 1 column of updates
const int n_restp1 = n_rest + 1; const blasint n_restp1 = n_rest + 1;
// last column of A_BR // last column of A_BR
double *const A_BR_r = A_BR + *ldA * n2_out + n2_out; double *const A_BR_r = A_BR + *ldA * n2_out + n2_out;
@ -169,7 +169,7 @@ static void RELAPACK_dsytrf_rook_rec(
n2 = n2_out; n2 = n2_out;
// shift pivots // shift pivots
int i; blasint i;
for (i = 0; i < n2; i++) for (i = 0; i < n2; i++)
if (ipiv_B[i] > 0) if (ipiv_B[i] > 0)
ipiv_B[i] += n1; ipiv_B[i] += n1;
@ -180,22 +180,22 @@ static void RELAPACK_dsytrf_rook_rec(
*n_out = n1 + n2; *n_out = n1 + n2;
} else { } else {
// Splitting (setup) // Splitting (setup)
int n2 = DREC_SPLIT(*n); blasint n2 = DREC_SPLIT(*n);
int n1 = *n - n2; blasint n1 = *n - n2;
// * Work_R // * Work_R
// (top recursion level: use Work as Work_R) // (top recursion level: use Work as Work_R)
double *const Work_R = top ? Work : Work + *ldWork * n1; double *const Work_R = top ? Work : Work + *ldWork * n1;
// recursion(A_R) // recursion(A_R)
int n2_out; blasint n2_out;
RELAPACK_dsytrf_rook_rec(uplo, n_full, &n2, &n2_out, A, ldA, ipiv, Work_R, ldWork, &info2); RELAPACK_dsytrf_rook_rec(uplo, n_full, &n2, &n2_out, A, ldA, ipiv, Work_R, ldWork, &info2);
const int n2_diff = n2 - n2_out; const blasint n2_diff = n2 - n2_out;
n2 = n2_out; n2 = n2_out;
// Splitting (continued) // Splitting (continued)
n1 = *n - n2; n1 = *n - n2;
const int n_full1 = *n_full - n2; const blasint n_full1 = *n_full - n2;
// * A_TL_T A_TR_T // * A_TL_T A_TR_T
// * A_TL A_TR // * A_TL A_TR
@ -211,19 +211,19 @@ static void RELAPACK_dsytrf_rook_rec(
// (top recursion level: Work_R was Work) // (top recursion level: Work_R was Work)
double *const Work_L = Work; double *const Work_L = Work;
double *const Work_TR = Work + *ldWork * (top ? n2_diff : n1) + n_rest; double *const Work_TR = Work + *ldWork * (top ? n2_diff : n1) + n_rest;
const int ldWork_L = top ? n1 : *ldWork; const blasint ldWork_L = top ? n1 : *ldWork;
// A_TL = A_TL - A_TR Work_TR' // A_TL = A_TL - A_TR Work_TR'
RELAPACK_dgemmt(uplo, "N", "T", &n1, &n2, MONE, A_TR, ldA, Work_TR, ldWork, ONE, A_TL, ldA); RELAPACK_dgemmt(uplo, "N", "T", &n1, &n2, MONE, A_TR, ldA, Work_TR, ldWork, ONE, A_TL, ldA);
BLAS(dgemm)("N", "T", &n_rest, &n1, &n2, MONE, A_TR_T, ldA, Work_TR, ldWork, ONE, A_TL_T, ldA); BLAS(dgemm)("N", "T", &n_rest, &n1, &n2, MONE, A_TR_T, ldA, Work_TR, ldWork, ONE, A_TL_T, ldA);
// recursion(A_TL) // recursion(A_TL)
int n1_out; blasint n1_out;
RELAPACK_dsytrf_rook_rec(uplo, &n_full1, &n1, &n1_out, A, ldA, ipiv, Work_L, &ldWork_L, &info1); RELAPACK_dsytrf_rook_rec(uplo, &n_full1, &n1, &n1_out, A, ldA, ipiv, Work_L, &ldWork_L, &info1);
if (n1_out != n1) { if (n1_out != n1) {
// undo 1 column of updates // undo 1 column of updates
const int n_restp1 = n_rest + 1; const blasint n_restp1 = n_rest + 1;
// A_TL_T_l = A_TL_T_l + A_TR_T Work_TR_t' // A_TL_T_l = A_TL_T_l + A_TR_T Work_TR_t'
BLAS(dgemv)("N", &n_restp1, &n2, ONE, A_TR_T, ldA, Work_TR, ldWork, ONE, A_TL_T, iONE); BLAS(dgemv)("N", &n_restp1, &n2, ONE, A_TR_T, ldA, Work_TR, ldWork, ONE, A_TL_T, iONE);

38
relapack/src/dsytrf_rook_rec2.c
View File

@ -14,7 +14,7 @@
/* Table of constant values */ /* Table of constant values */
static int c__1 = 1; static blasint c__1 = 1;
static double c_b9 = -1.; static double c_b9 = -1.;
static double c_b10 = 1.; static double c_b10 = 1.;
@ -25,39 +25,39 @@ static double c_b10 = 1.;
* The blocked BLAS Level 3 updates were removed and moved to the * The blocked BLAS Level 3 updates were removed and moved to the
* recursive algorithm. * recursive algorithm.
* */ * */
/* Subroutine */ void RELAPACK_dsytrf_rook_rec2(char *uplo, int *n, /* Subroutine */ void RELAPACK_dsytrf_rook_rec2(char *uplo, blasint *n,
int *nb, int *kb, double *a, int *lda, int *ipiv, int *nb, blasint *kb, double *a, blasint *lda, blasint *ipiv,
double *w, int *ldw, int *info, ftnlen uplo_len) double *w, blasint *ldw, blasint *info, ftnlen uplo_len)
{ {
/* System generated locals */ /* System generated locals */
int a_dim1, a_offset, w_dim1, w_offset, i__1, i__2; blasint a_dim1, a_offset, w_dim1, w_offset, i__1, i__2;
double d__1; double d__1;
/* Builtin functions */ /* Builtin functions */
double sqrt(double); double sqrt(double);
/* Local variables */ /* Local variables */
static int j, k, p; static blasint j, k, p;
static double t, r1, d11, d12, d21, d22; static double t, r1, d11, d12, d21, d22;
static int ii, jj, kk, kp, kw, jp1, jp2, kkw; static blasint ii, jj, kk, kp, kw, jp1, jp2, kkw;
static logical done; static logical done;
static int imax, jmax; static blasint imax, jmax;
static double alpha; static double alpha;
extern /* Subroutine */ int dscal_(int *, double *, double *, extern /* Subroutine */ blasint dscal_(int *, double *, double *,
int *); blasint *);
extern logical lsame_(char *, char *, ftnlen, ftnlen); extern logical lsame_(char *, char *, ftnlen, ftnlen);
extern /* Subroutine */ int dgemv_(char *, int *, int *, extern /* Subroutine */ blasint dgemv_(char *, blasint *, blasint *,
double *, double *, int *, double *, int *, double *, double *, blasint *, double *, blasint *,
double *, double *, int *, ftnlen); double *, double *, blasint *, ftnlen);
static double dtemp, sfmin; static double dtemp, sfmin;
static int itemp; static blasint itemp;
extern /* Subroutine */ int dcopy_(int *, double *, int *, extern /* Subroutine */ blasint dcopy_(int *, double *, blasint *,
double *, int *), dswap_(int *, double *, int double *, blasint *), dswap_(int *, double *, int
*, double *, int *); *, double *, blasint *);
static int kstep; static blasint kstep;
extern double dlamch_(char *, ftnlen); extern double dlamch_(char *, ftnlen);
static double absakk; static double absakk;
extern int idamax_(int *, double *, int *); extern blasint idamax_(int *, double *, blasint *);
static double colmax, rowmax; static double colmax, rowmax;
/* Parameter adjustments */ /* Parameter adjustments */

66
relapack/src/dtgsyl.c
View File

@ -1,11 +1,11 @@
#include "relapack.h" #include "relapack.h"
#include <math.h> #include <math.h>
static void RELAPACK_dtgsyl_rec(const char *, const int *, const int *, static void RELAPACK_dtgsyl_rec(const char *, const blasint *, const blasint *,
const int *, const double *, const int *, const double *, const int *, const blasint *, const double *, const blasint *, const double *, const blasint *,
double *, const int *, const double *, const int *, const double *, double *, const blasint *, const double *, const blasint *, const double *,
const int *, double *, const int *, double *, double *, double *, int *, const blasint *, double *, const blasint *, double *, double *, double *, blasint *,
int *, int *); blasint *, blasint *);
/** DTGSYL solves the generalized Sylvester equation. /** DTGSYL solves the generalized Sylvester equation.
@ -15,21 +15,21 @@ static void RELAPACK_dtgsyl_rec(const char *, const int *, const int *,
* http://www.netlib.org/lapack/explore-html/db/d88/dtgsyl_8f.html * http://www.netlib.org/lapack/explore-html/db/d88/dtgsyl_8f.html
* */ * */
void RELAPACK_dtgsyl( void RELAPACK_dtgsyl(
const char *trans, const int *ijob, const int *m, const int *n, const char *trans, const blasint *ijob, const blasint *m, const blasint *n,
const double *A, const int *ldA, const double *B, const int *ldB, const double *A, const blasint *ldA, const double *B, const blasint *ldB,
double *C, const int *ldC, double *C, const blasint *ldC,
const double *D, const int *ldD, const double *E, const int *ldE, const double *D, const blasint *ldD, const double *E, const blasint *ldE,
double *F, const int *ldF, double *F, const blasint *ldF,
double *scale, double *dif, double *scale, double *dif,
double *Work, const int *lWork, int *iWork, int *info double *Work, const blasint *lWork, blasint *iWork, blasint *info
) { ) {
// Parse arguments // Parse arguments
const int notran = LAPACK(lsame)(trans, "N"); const blasint notran = LAPACK(lsame)(trans, "N");
const int tran = LAPACK(lsame)(trans, "T"); const blasint tran = LAPACK(lsame)(trans, "T");
// Compute work buffer size // Compute work buffer size
int lwmin = 1; blasint lwmin = 1;
if (notran && (*ijob == 1 || *ijob == 2)) if (notran && (*ijob == 1 || *ijob == 2))
lwmin = MAX(1, 2 * *m * *n); lwmin = MAX(1, 2 * *m * *n);
*info = 0; *info = 0;
@ -58,8 +58,8 @@ void RELAPACK_dtgsyl(
else if (*lWork < lwmin && *lWork != -1) else if (*lWork < lwmin && *lWork != -1)
*info = -20; *info = -20;
if (*info) { if (*info) {
const int minfo = -*info; const blasint minfo = -*info;
LAPACK(xerbla)("DTGSYL", &minfo); LAPACK(xerbla)("DTGSYL", &minfo, strlen("DTGSYL"));
return; return;
} }
@ -75,8 +75,8 @@ void RELAPACK_dtgsyl(
// Constant // Constant
const double ZERO[] = { 0. }; const double ZERO[] = { 0. };
int isolve = 1; blasint isolve = 1;
int ifunc = 0; blasint ifunc = 0;
if (notran) { if (notran) {
if (*ijob >= 3) { if (*ijob >= 3) {
ifunc = *ijob - 2; ifunc = *ijob - 2;
@ -87,12 +87,12 @@ void RELAPACK_dtgsyl(
} }
double scale2; double scale2;
int iround; blasint iround;
for (iround = 1; iround <= isolve; iround++) { for (iround = 1; iround <= isolve; iround++) {
*scale = 1; *scale = 1;
double dscale = 0; double dscale = 0;
double dsum = 1; double dsum = 1;
int pq; blasint pq;
RELAPACK_dtgsyl_rec(&cleantrans, &ifunc, m, n, A, ldA, B, ldB, C, ldC, D, ldD, E, ldE, F, ldF, scale, &dsum, &dscale, iWork, &pq, info); RELAPACK_dtgsyl_rec(&cleantrans, &ifunc, m, n, A, ldA, B, ldB, C, ldC, D, ldD, E, ldE, F, ldF, scale, &dsum, &dscale, iWork, &pq, info);
if (dscale != 0) { if (dscale != 0) {
if (*ijob == 1 || *ijob == 3) if (*ijob == 1 || *ijob == 3)
@ -121,13 +121,13 @@ void RELAPACK_dtgsyl(
/** dtgsyl's recursive vompute kernel */ /** dtgsyl's recursive vompute kernel */
static void RELAPACK_dtgsyl_rec( static void RELAPACK_dtgsyl_rec(
const char *trans, const int *ifunc, const int *m, const int *n, const char *trans, const blasint *ifunc, const blasint *m, const blasint *n,
const double *A, const int *ldA, const double *B, const int *ldB, const double *A, const blasint *ldA, const double *B, const blasint *ldB,
double *C, const int *ldC, double *C, const blasint *ldC,
const double *D, const int *ldD, const double *E, const int *ldE, const double *D, const blasint *ldD, const double *E, const blasint *ldE,
double *F, const int *ldF, double *F, const blasint *ldF,
double *scale, double *dsum, double *dscale, double *scale, double *dsum, double *dscale,
int *iWork, int *pq, int *info blasint *iWork, blasint *pq, blasint *info
) { ) {
if (*m <= MAX(CROSSOVER_DTGSYL, 1) && *n <= MAX(CROSSOVER_DTGSYL, 1)) { if (*m <= MAX(CROSSOVER_DTGSYL, 1) && *n <= MAX(CROSSOVER_DTGSYL, 1)) {
@ -139,20 +139,20 @@ static void RELAPACK_dtgsyl_rec(
// Constants // Constants
const double ONE[] = { 1. }; const double ONE[] = { 1. };
const double MONE[] = { -1. }; const double MONE[] = { -1. };
const int iONE[] = { 1 }; const blasint iONE[] = { 1 };
// Outputs // Outputs
double scale1[] = { 1. }; double scale1[] = { 1. };
double scale2[] = { 1. }; double scale2[] = { 1. };
int info1[] = { 0 }; blasint info1[] = { 0 };
int info2[] = { 0 }; blasint info2[] = { 0 };
if (*m > *n) { if (*m > *n) {
// Splitting // Splitting
int m1 = DREC_SPLIT(*m); blasint m1 = DREC_SPLIT(*m);
if (A[m1 + *ldA * (m1 - 1)]) if (A[m1 + *ldA * (m1 - 1)])
m1++; m1++;
const int m2 = *m - m1; const blasint m2 = *m - m1;
// A_TL A_TR // A_TL A_TR
// 0 A_BR // 0 A_BR
@ -210,10 +210,10 @@ static void RELAPACK_dtgsyl_rec(
} }
} else { } else {
// Splitting // Splitting
int n1 = DREC_SPLIT(*n); blasint n1 = DREC_SPLIT(*n);
if (B[n1 + *ldB * (n1 - 1)]) if (B[n1 + *ldB * (n1 - 1)])
n1++; n1++;
const int n2 = *n - n1; const blasint n2 = *n - n1;
// B_TL B_TR // B_TL B_TR
// 0 B_BR // 0 B_BR

56
relapack/src/dtrsyl.c
View File

@ -1,8 +1,8 @@
#include "relapack.h" #include "relapack.h"
static void RELAPACK_dtrsyl_rec(const char *, const char *, const int *, static void RELAPACK_dtrsyl_rec(const char *, const char *, const blasint *,
const int *, const int *, const double *, const int *, const double *, const blasint *, const blasint *, const double *, const blasint *, const double *,
const int *, double *, const int *, double *, int *); const blasint *, double *, const blasint *, double *, blasint *);
/** DTRSYL solves the real Sylvester matrix equation. /** DTRSYL solves the real Sylvester matrix equation.
@ -12,20 +12,20 @@ static void RELAPACK_dtrsyl_rec(const char *, const char *, const int *,
* http://www.netlib.org/lapack/explore-html/d6/d43/dtrsyl_8f.html * http://www.netlib.org/lapack/explore-html/d6/d43/dtrsyl_8f.html
* */ * */
void RELAPACK_dtrsyl( void RELAPACK_dtrsyl(
const char *tranA, const char *tranB, const int *isgn, const char *tranA, const char *tranB, const blasint *isgn,
const int *m, const int *n, const blasint *m, const blasint *n,
const double *A, const int *ldA, const double *B, const int *ldB, const double *A, const blasint *ldA, const double *B, const blasint *ldB,
double *C, const int *ldC, double *scale, double *C, const blasint *ldC, double *scale,
int *info blasint *info
) { ) {
// Check arguments // Check arguments
const int notransA = LAPACK(lsame)(tranA, "N"); const blasint notransA = LAPACK(lsame)(tranA, "N");
const int transA = LAPACK(lsame)(tranA, "T"); const blasint transA = LAPACK(lsame)(tranA, "T");
const int ctransA = LAPACK(lsame)(tranA, "C"); const blasint ctransA = LAPACK(lsame)(tranA, "C");
const int notransB = LAPACK(lsame)(tranB, "N"); const blasint notransB = LAPACK(lsame)(tranB, "N");
const int transB = LAPACK(lsame)(tranB, "T"); const blasint transB = LAPACK(lsame)(tranB, "T");
const int ctransB = LAPACK(lsame)(tranB, "C"); const blasint ctransB = LAPACK(lsame)(tranB, "C");
*info = 0; *info = 0;
if (!transA && !ctransA && !notransA) if (!transA && !ctransA && !notransA)
*info = -1; *info = -1;
@ -44,8 +44,8 @@ void RELAPACK_dtrsyl(
else if (*ldC < MAX(1, *m)) else if (*ldC < MAX(1, *m))
*info = -11; *info = -11;
if (*info) { if (*info) {
const int minfo = -*info; const blasint minfo = -*info;
LAPACK(xerbla)("DTRSYL", &minfo); LAPACK(xerbla)("DTRSYL", &minfo, strlen("DTRSYL"));
return; return;
} }
@ -60,11 +60,11 @@ void RELAPACK_dtrsyl(
/** dtrsyl's recursive compute kernel */ /** dtrsyl's recursive compute kernel */
static void RELAPACK_dtrsyl_rec( static void RELAPACK_dtrsyl_rec(
const char *tranA, const char *tranB, const int *isgn, const char *tranA, const char *tranB, const blasint *isgn,
const int *m, const int *n, const blasint *m, const blasint *n,
const double *A, const int *ldA, const double *B, const int *ldB, const double *A, const blasint *ldA, const double *B, const blasint *ldB,
double *C, const int *ldC, double *scale, double *C, const blasint *ldC, double *scale,
int *info blasint *info
) { ) {
if (*m <= MAX(CROSSOVER_DTRSYL, 1) && *n <= MAX(CROSSOVER_DTRSYL, 1)) { if (*m <= MAX(CROSSOVER_DTRSYL, 1) && *n <= MAX(CROSSOVER_DTRSYL, 1)) {
@ -77,20 +77,20 @@ static void RELAPACK_dtrsyl_rec(
const double ONE[] = { 1. }; const double ONE[] = { 1. };
const double MONE[] = { -1. }; const double MONE[] = { -1. };
const double MSGN[] = { -*isgn }; const double MSGN[] = { -*isgn };
const int iONE[] = { 1 }; const blasint iONE[] = { 1 };
// Outputs // Outputs
double scale1[] = { 1. }; double scale1[] = { 1. };
double scale2[] = { 1. }; double scale2[] = { 1. };
int info1[] = { 0 }; blasint info1[] = { 0 };
int info2[] = { 0 }; blasint info2[] = { 0 };
if (*m > *n) { if (*m > *n) {
// Splitting // Splitting
int m1 = DREC_SPLIT(*m); blasint m1 = DREC_SPLIT(*m);
if (A[m1 + *ldA * (m1 - 1)]) if (A[m1 + *ldA * (m1 - 1)])
m1++; m1++;
const int m2 = *m - m1; const blasint m2 = *m - m1;
// A_TL A_TR // A_TL A_TR
// 0 A_BR // 0 A_BR
@ -126,10 +126,10 @@ static void RELAPACK_dtrsyl_rec(
} }
} else { } else {
// Splitting // Splitting
int n1 = DREC_SPLIT(*n); blasint n1 = DREC_SPLIT(*n);
if (B[n1 + *ldB * (n1 - 1)]) if (B[n1 + *ldB * (n1 - 1)])
n1++; n1++;
const int n2 = *n - n1; const blasint n2 = *n - n1;
// B_TL B_TR // B_TL B_TR
// 0 B_BR // 0 B_BR

58
relapack/src/dtrsyl_rec2.c
View File

@ -14,52 +14,52 @@
/* Table of constant values */ /* Table of constant values */
static int c__1 = 1; static blasint c__1 = 1;
static int c_false = FALSE_; static blasint c_false = FALSE_;
static int c__2 = 2; static blasint c__2 = 2;
static double c_b26 = 1.; static double c_b26 = 1.;
static double c_b30 = 0.; static double c_b30 = 0.;
static int c_true = TRUE_; static blasint c_true = TRUE_;
int RELAPACK_dtrsyl_rec2(char *trana, char *tranb, int *isgn, int int RELAPACK_dtrsyl_rec2(char *trana, char *tranb, blasint *isgn, int
*m, int *n, double *a, int *lda, double *b, int * *m, blasint *n, double *a, blasint *lda, double *b, blasint *
ldb, double *c__, int *ldc, double *scale, int *info, ldb, double *c__, blasint *ldc, double *scale, blasint *info,
ftnlen trana_len, ftnlen tranb_len) ftnlen trana_len, ftnlen tranb_len)
{ {
/* System generated locals */ /* System generated locals */
int a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2, blasint a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2,
i__3, i__4; i__3, i__4;
double d__1, d__2; double d__1, d__2;
/* Local variables */ /* Local variables */
static int j, k, l; static blasint j, k, l;
static double x[4] /* was [2][2] */; static double x[4] /* was [2][2] */;
static int k1, k2, l1, l2; static blasint k1, k2, l1, l2;
static double a11, db, da11, vec[4] /* was [2][2] */, dum[1], eps, static double a11, db, da11, vec[4] /* was [2][2] */, dum[1], eps,
sgn; sgn;
extern double ddot_(int *, double *, int *, double *, extern double ddot_(int *, double *, blasint *, double *,
int *); blasint *);
static int ierr; static blasint ierr;
static double smin, suml, sumr; static double smin, suml, sumr;
extern /* Subroutine */ int dscal_(int *, double *, double *, extern /* Subroutine */ blasint dscal_(int *, double *, double *,
int *); blasint *);
extern int lsame_(char *, char *, ftnlen, ftnlen); extern blasint lsame_(char *, char *, ftnlen, ftnlen);
static int knext, lnext; static blasint knext, lnext;
static double xnorm; static double xnorm;
extern /* Subroutine */ int dlaln2_(int *, int *, int *, extern /* Subroutine */ blasint dlaln2_(int *, blasint *, blasint *,
double *, double *, double *, int *, double *, double *, double *, double *, blasint *, double *,
double *, double *, int *, double *, double * double *, double *, blasint *, double *, double *
, double *, int *, double *, double *, int *), , double *, blasint *, double *, double *, blasint *),
dlasy2_(int *, int *, int *, int *, int *, dlasy2_(int *, blasint *, blasint *, blasint *, blasint *,
double *, int *, double *, int *, double *, double *, blasint *, double *, blasint *, double *,
int *, double *, double *, int *, double *, blasint *, double *, double *, blasint *, double *,
int *), dlabad_(double *, double *); blasint *), dlabad_(double *, double *);
extern double dlamch_(char *, ftnlen), dlange_(char *, int *, extern double dlamch_(char *, ftnlen), dlange_(char *, blasint *,
int *, double *, int *, double *, ftnlen); blasint *, double *, blasint *, double *, ftnlen);
static double scaloc; static double scaloc;
extern /* Subroutine */ int xerbla_(char *, int *, ftnlen); extern /* Subroutine */ blasint xerbla_(char *, blasint *, ftnlen);
static double bignum; static double bignum;
static int notrna, notrnb; static blasint notrna, notrnb;
static double smlnum; static double smlnum;
/* Parameter adjustments */ /* Parameter adjustments */

34
relapack/src/dtrtri.c
View File

@ -1,7 +1,7 @@
#include "relapack.h" #include "relapack.h"
static void RELAPACK_dtrtri_rec(const char *, const char *, const int *, static void RELAPACK_dtrtri_rec(const char *, const char *, const blasint *,
double *, const int *, int *); double *, const blasint *, blasint *);
/** DTRTRI computes the inverse of a real upper or lower triangular matrix A. /** DTRTRI computes the inverse of a real upper or lower triangular matrix A.
@ -11,16 +11,16 @@ static void RELAPACK_dtrtri_rec(const char *, const char *, const int *,
* http://www.netlib.org/lapack/explore-html/d5/dba/dtrtri_8f.html * http://www.netlib.org/lapack/explore-html/d5/dba/dtrtri_8f.html
* */ * */
void RELAPACK_dtrtri( void RELAPACK_dtrtri(
const char *uplo, const char *diag, const int *n, const char *uplo, const char *diag, const blasint *n,
double *A, const int *ldA, double *A, const blasint *ldA,
int *info blasint *info
) { ) {
// Check arguments // Check arguments
const int lower = LAPACK(lsame)(uplo, "L"); const blasint lower = LAPACK(lsame)(uplo, "L");
const int upper = LAPACK(lsame)(uplo, "U"); const blasint upper = LAPACK(lsame)(uplo, "U");
const int nounit = LAPACK(lsame)(diag, "N"); const blasint nounit = LAPACK(lsame)(diag, "N");
const int unit = LAPACK(lsame)(diag, "U"); const blasint unit = LAPACK(lsame)(diag, "U");
*info = 0; *info = 0;
if (!lower && !upper) if (!lower && !upper)
*info = -1; *info = -1;
@ -31,8 +31,8 @@ void RELAPACK_dtrtri(
else if (*ldA < MAX(1, *n)) else if (*ldA < MAX(1, *n))
*info = -5; *info = -5;
if (*info) { if (*info) {
const int minfo = -*info; const blasint minfo = -*info;
LAPACK(xerbla)("DTRTRI", &minfo); LAPACK(xerbla)("DTRTRI", &minfo, strlen("DTRTRI"));
return; return;
} }
@ -42,7 +42,7 @@ void RELAPACK_dtrtri(
// check for singularity // check for singularity
if (nounit) { if (nounit) {
int i; blasint i;
for (i = 0; i < *n; i++) for (i = 0; i < *n; i++)
if (A[i + *ldA * i] == 0) { if (A[i + *ldA * i] == 0) {
*info = i; *info = i;
@ -57,9 +57,9 @@ void RELAPACK_dtrtri(
/** dtrtri's recursive compute kernel */ /** dtrtri's recursive compute kernel */
static void RELAPACK_dtrtri_rec( static void RELAPACK_dtrtri_rec(
const char *uplo, const char *diag, const int *n, const char *uplo, const char *diag, const blasint *n,
double *A, const int *ldA, double *A, const blasint *ldA,
int *info blasint *info
){ ){
if (*n <= MAX(CROSSOVER_DTRTRI, 1)) { if (*n <= MAX(CROSSOVER_DTRTRI, 1)) {
@ -73,8 +73,8 @@ static void RELAPACK_dtrtri_rec(
const double MONE[] = { -1. }; const double MONE[] = { -1. };
// Splitting // Splitting
const int n1 = DREC_SPLIT(*n); const blasint n1 = DREC_SPLIT(*n);
const int n2 = *n - n1; const blasint n2 = *n - n1;
// A_TL A_TR // A_TL A_TR
// A_BL A_BR // A_BL A_BR

2
relapack/src/f2c.c
View File

@ -9,7 +9,7 @@
#endif #endif
#endif #endif
void sig_die(const char *s, int kill) { void sig_die(const char *s, blasint kill) {
/* print error message, then clear buffers */ /* print error message, then clear buffers */
fprintf(stderr, "%s\n", s); fprintf(stderr, "%s\n", s);

13
relapack/src/f2c.h
View File

@ -7,6 +7,19 @@
#ifndef F2C_INCLUDE #ifndef F2C_INCLUDE
#define F2C_INCLUDE #define F2C_INCLUDE
#ifdef USE64BITINT
typedef BLASLONG blasint;
#if defined(OS_WINDOWS) && defined(__64BIT__)
#define blasabs(x) llabs(x)
#else
#define blasabs(x) labs(x)
#endif
#else
typedef int blasint;
#define blasabs(x) abs(x)
#endif
typedef long int integer; typedef long int integer;
typedef unsigned long int uinteger; typedef unsigned long int uinteger;
typedef char *address; typedef char *address;

124
relapack/src/lapack.h
View File

@ -1,80 +1,80 @@
#ifndef LAPACK_H #ifndef LAPACK_H
#define LAPACK_H #define LAPACK_H
extern int LAPACK(lsame)(const char *, const char *); extern blasint LAPACK(lsame)(const char *, const char *);
extern int LAPACK(xerbla)(const char *, const int *); extern blasint LAPACK(xerbla)(const char *, const blasint *, int);
extern void LAPACK(slaswp)(const int *, float *, const int *, const int *, const int *, const int *, const int *); extern void LAPACK(slaswp)(const blasint *, float *, const blasint *, const blasint *, const blasint *, const blasint *, const blasint *);
extern void LAPACK(dlaswp)(const int *, double *, const int *, const int *, const int *, const int *, const int *); extern void LAPACK(dlaswp)(const blasint *, double *, const blasint *, const blasint *, const blasint *, const blasint *, const blasint *);
extern void LAPACK(claswp)(const int *, float *, const int *, const int *, const int *, const int *, const int *); extern void LAPACK(claswp)(const blasint *, float *, const blasint *, const blasint *, const blasint *, const blasint *, const blasint *);
extern void LAPACK(zlaswp)(const int *, double *, const int *, const int *, const int *, const int *, const int *); extern void LAPACK(zlaswp)(const blasint *, double *, const blasint *, const blasint *, const blasint *, const blasint *, const blasint *);
extern void LAPACK(slaset)(const char *, const int *, const int *, const float *, const float *, float *, const int *); extern void LAPACK(slaset)(const char *, const blasint *, const blasint *, const float *, const float *, float *, const blasint *);
extern void LAPACK(dlaset)(const char *, const int *, const int *, const double *, const double *, double *, const int *); extern void LAPACK(dlaset)(const char *, const blasint *, const blasint *, const double *, const double *, double *, const blasint *);
extern void LAPACK(claset)(const char *, const int *, const int *, const float *, const float *, float *, const int *); extern void LAPACK(claset)(const char *, const blasint *, const blasint *, const float *, const float *, float *, const blasint *);
extern void LAPACK(zlaset)(const char *, const int *, const int *, const double *, const double *, double *, const int *); extern void LAPACK(zlaset)(const char *, const blasint *, const blasint *, const double *, const double *, double *, const blasint *);
extern void LAPACK(slacpy)(const char *, const int *, const int *, const float *, const int *, float *, const int *); extern void LAPACK(slacpy)(const char *, const blasint *, const blasint *, const float *, const blasint *, float *, const blasint *);
extern void LAPACK(dlacpy)(const char *, const int *, const int *, const double *, const int *, double *, const int *); extern void LAPACK(dlacpy)(const char *, const blasint *, const blasint *, const double *, const blasint *, double *, const blasint *);
extern void LAPACK(clacpy)(const char *, const int *, const int *, const float *, const int *, float *, const int *); extern void LAPACK(clacpy)(const char *, const blasint *, const blasint *, const float *, const blasint *, float *, const blasint *);
extern void LAPACK(zlacpy)(const char *, const int *, const int *, const double *, const int *, double *, const int *); extern void LAPACK(zlacpy)(const char *, const blasint *, const blasint *, const double *, const blasint *, double *, const blasint *);
extern void LAPACK(slascl)(const char *, const int *, const int *, const float *, const float *, const int *, const int *, float *, const int *, int *); extern void LAPACK(slascl)(const char *, const blasint *, const blasint *, const float *, const float *, const blasint *, const blasint *, float *, const blasint *, blasint *);
extern void LAPACK(dlascl)(const char *, const int *, const int *, const double *, const double *, const int *, const int *, double *, const int *, int *); extern void LAPACK(dlascl)(const char *, const blasint *, const blasint *, const double *, const double *, const blasint *, const blasint *, double *, const blasint *, blasint *);
extern void LAPACK(clascl)(const char *, const int *, const int *, const float *, const float *, const int *, const int *, float *, const int *, int *); extern void LAPACK(clascl)(const char *, const blasint *, const blasint *, const float *, const float *, const blasint *, const blasint *, float *, const blasint *, blasint *);
extern void LAPACK(zlascl)(const char *, const int *, const int *, const double *, const double *, const int *, const int *, double *, const int *, int *); extern void LAPACK(zlascl)(const char *, const blasint *, const blasint *, const double *, const double *, const blasint *, const blasint *, double *, const blasint *, blasint *);
extern void LAPACK(slauu2)(const char *, const int *, float *, const int *, int *); extern void LAPACK(slauu2)(const char *, const blasint *, float *, const blasint *, blasint *);
extern void LAPACK(dlauu2)(const char *, const int *, double *, const int *, int *); extern void LAPACK(dlauu2)(const char *, const blasint *, double *, const blasint *, blasint *);
extern void LAPACK(clauu2)(const char *, const int *, float *, const int *, int *); extern void LAPACK(clauu2)(const char *, const blasint *, float *, const blasint *, blasint *);
extern void LAPACK(zlauu2)(const char *, const int *, double *, const int *, int *); extern void LAPACK(zlauu2)(const char *, const blasint *, double *, const blasint *, blasint *);
extern void LAPACK(ssygs2)(const int *, const char *, const int *, float *, const int *, const float *, const int *, int *); extern void LAPACK(ssygs2)(const blasint *, const char *, const blasint *, float *, const blasint *, const float *, const blasint *, blasint *);
extern void LAPACK(dsygs2)(const int *, const char *, const int *, double *, const int *, const double *, const int *, int *); extern void LAPACK(dsygs2)(const blasint *, const char *, const blasint *, double *, const blasint *, const double *, const blasint *, blasint *);
extern void LAPACK(chegs2)(const int *, const char *, const int *, float *, const int *, const float *, const int *, int *); extern void LAPACK(chegs2)(const blasint *, const char *, const blasint *, float *, const blasint *, const float *, const blasint *, blasint *);
extern void LAPACK(zhegs2)(const int *, const char *, const int *, double *, const int *, const double *, const int *, int *); extern void LAPACK(zhegs2)(const blasint *, const char *, const blasint *, double *, const blasint *, const double *, const blasint *, blasint *);
extern void LAPACK(strti2)(const char *, const char *, const int *, float *, const int *, int *); extern void LAPACK(strti2)(const char *, const char *, const blasint *, float *, const blasint *, blasint *);
extern void LAPACK(dtrti2)(const char *, const char *, const int *, double *, const int *, int *); extern void LAPACK(dtrti2)(const char *, const char *, const blasint *, double *, const blasint *, blasint *);
extern void LAPACK(ctrti2)(const char *, const char *, const int *, float *, const int *, int *); extern void LAPACK(ctrti2)(const char *, const char *, const blasint *, float *, const blasint *, blasint *);
extern void LAPACK(ztrti2)(const char *, const char *, const int *, double *, const int *, int *); extern void LAPACK(ztrti2)(const char *, const char *, const blasint *, double *, const blasint *, blasint *);
extern void LAPACK(spotf2)(const char *, const int *, float *, const int *, int *); extern void LAPACK(spotf2)(const char *, const blasint *, float *, const blasint *, blasint *);
extern void LAPACK(dpotf2)(const char *, const int *, double *, const int *, int *); extern void LAPACK(dpotf2)(const char *, const blasint *, double *, const blasint *, blasint *);
extern void LAPACK(cpotf2)(const char *, const int *, float *, const int *, int *); extern void LAPACK(cpotf2)(const char *, const blasint *, float *, const blasint *, blasint *);
extern void LAPACK(zpotf2)(const char *, const int *, double *, const int *, int *); extern void LAPACK(zpotf2)(const char *, const blasint *, double *, const blasint *, blasint *);
extern void LAPACK(spbtf2)(const char *, const int *, const int *, float *, const int *, int *); extern void LAPACK(spbtf2)(const char *, const blasint *, const blasint *, float *, const blasint *, blasint *);
extern void LAPACK(dpbtf2)(const char *, const int *, const int *, double *, const int *, int *); extern void LAPACK(dpbtf2)(const char *, const blasint *, const blasint *, double *, const blasint *, blasint *);
extern void LAPACK(cpbtf2)(const char *, const int *, const int *, float *, const int *, int *); extern void LAPACK(cpbtf2)(const char *, const blasint *, const blasint *, float *, const blasint *, blasint *);
extern void LAPACK(zpbtf2)(const char *, const int *, const int *, double *, const int *, int *); extern void LAPACK(zpbtf2)(const char *, const blasint *, const blasint *, double *, const blasint *, blasint *);
extern void LAPACK(ssytf2)(const char *, const int *, float *, const int *, int *, int *); extern void LAPACK(ssytf2)(const char *, const blasint *, float *, const blasint *, blasint *, blasint *);
extern void LAPACK(dsytf2)(const char *, const int *, double *, const int *, int *, int *); extern void LAPACK(dsytf2)(const char *, const blasint *, double *, const blasint *, blasint *, blasint *);
extern void LAPACK(csytf2)(const char *, const int *, float *, const int *, int *, int *); extern void LAPACK(csytf2)(const char *, const blasint *, float *, const blasint *, blasint *, blasint *);
extern void LAPACK(chetf2)(const char *, const int *, float *, const int *, int *, int *); extern void LAPACK(chetf2)(const char *, const blasint *, float *, const blasint *, blasint *, blasint *);
extern void LAPACK(zsytf2)(const char *, const int *, double *, const int *, int *, int *); extern void LAPACK(zsytf2)(const char *, const blasint *, double *, const blasint *, blasint *, blasint *);
extern void LAPACK(zhetf2)(const char *, const int *, double *, const int *, int *, int *); extern void LAPACK(zhetf2)(const char *, const blasint *, double *, const blasint *, blasint *, blasint *);
extern void LAPACK(ssytf2_rook)(const char *, const int *, float *, const int *, int *, int *); extern void LAPACK(ssytf2_rook)(const char *, const blasint *, float *, const blasint *, blasint *, blasint *);
extern void LAPACK(dsytf2_rook)(const char *, const int *, double *, const int *, int *, int *); extern void LAPACK(dsytf2_rook)(const char *, const blasint *, double *, const blasint *, blasint *, blasint *);
extern void LAPACK(csytf2_rook)(const char *, const int *, float *, const int *, int *, int *); extern void LAPACK(csytf2_rook)(const char *, const blasint *, float *, const blasint *, blasint *, blasint *);
extern void LAPACK(chetf2_rook)(const char *, const int *, float *, const int *, int *, int *); extern void LAPACK(chetf2_rook)(const char *, const blasint *, float *, const blasint *, blasint *, blasint *);
extern void LAPACK(zsytf2_rook)(const char *, const int *, double *, const int *, int *, int *); extern void LAPACK(zsytf2_rook)(const char *, const blasint *, double *, const blasint *, blasint *, blasint *);
extern void LAPACK(zhetf2_rook)(const char *, const int *, double *, const int *, int *, int *); extern void LAPACK(zhetf2_rook)(const char *, const blasint *, double *, const blasint *, blasint *, blasint *);
extern void LAPACK(sgetf2)(const int *, const int *, float *, const int *, int *, int *); extern void LAPACK(sgetf2)(const blasint *, const blasint *, float *, const blasint *, blasint *, blasint *);
extern void LAPACK(dgetf2)(const int *, const int *, double *, const int *, int *, int *); extern void LAPACK(dgetf2)(const blasint *, const blasint *, double *, const blasint *, blasint *, blasint *);
extern void LAPACK(cgetf2)(const int *, const int *, float *, const int *, int *, int *); extern void LAPACK(cgetf2)(const blasint *, const blasint *, float *, const blasint *, blasint *, blasint *);
extern void LAPACK(zgetf2)(const int *, const int *, double *, const int *, int *, int *); extern void LAPACK(zgetf2)(const blasint *, const blasint *, double *, const blasint *, blasint *, blasint *);
extern void LAPACK(sgbtf2)(const int *, const int *, const int *, const int *, float *, const int *, int *, int *); extern void LAPACK(sgbtf2)(const blasint *, const blasint *, const blasint *, const blasint *, float *, const blasint *, blasint *, blasint *);
extern void LAPACK(dgbtf2)(const int *, const int *, const int *, const int *, double *, const int *, int *, int *); extern void LAPACK(dgbtf2)(const blasint *, const blasint *, const blasint *, const blasint *, double *, const blasint *, blasint *, blasint *);
extern void LAPACK(cgbtf2)(const int *, const int *, const int *, const int *, float *, const int *, int *, int *); extern void LAPACK(cgbtf2)(const blasint *, const blasint *, const blasint *, const blasint *, float *, const blasint *, blasint *, blasint *);
extern void LAPACK(zgbtf2)(const int *, const int *, const int *, const int *, double *, const int *, int *, int *); extern void LAPACK(zgbtf2)(const blasint *, const blasint *, const blasint *, const blasint *, double *, const blasint *, blasint *, blasint *);
extern void LAPACK(stgsy2)(const char *, const int *, const int *, const int *, const float *, const int *, const float *, const int *, float *, const int *, const float *, const int *, const float *, const int *, float *, const int *, float *, float *, float *, int *, int *, int *); extern void LAPACK(stgsy2)(const char *, const blasint *, const blasint *, const blasint *, const float *, const blasint *, const float *, const blasint *, float *, const blasint *, const float *, const blasint *, const float *, const blasint *, float *, const blasint *, float *, float *, float *, blasint *, blasint *, blasint *);
extern void LAPACK(dtgsy2)(const char *, const int *, const int *, const int *, const double *, const int *, const double *, const int *, double *, const int *, const double *, const int *, const double *, const int *, double *, const int *, double *, double *, double *, int *, int *, int *); extern void LAPACK(dtgsy2)(const char *, const blasint *, const blasint *, const blasint *, const double *, const blasint *, const double *, const blasint *, double *, const blasint *, const double *, const blasint *, const double *, const blasint *, double *, const blasint *, double *, double *, double *, blasint *, blasint *, blasint *);
extern void LAPACK(ctgsy2)(const char *, const int *, const int *, const int *, const float *, const int *, const float *, const int *, float *, const int *, const float *, const int *, const float *, const int *, float *, const int *, float *, float *, float *, int *); extern void LAPACK(ctgsy2)(const char *, const blasint *, const blasint *, const blasint *, const float *, const blasint *, const float *, const blasint *, float *, const blasint *, const float *, const blasint *, const float *, const blasint *, float *, const blasint *, float *, float *, float *, blasint *);
extern void LAPACK(ztgsy2)(const char *, const int *, const int *, const int *, const double *, const int *, const double *, const int *, double *, const int *, const double *, const int *, const double *, const int *, double *, const int *, double *, double *, double *, int *); extern void LAPACK(ztgsy2)(const char *, const blasint *, const blasint *, const blasint *, const double *, const blasint *, const double *, const blasint *, double *, const blasint *, const double *, const blasint *, const double *, const blasint *, double *, const blasint *, double *, double *, double *, blasint *);
#endif /* LAPACK_H */ #endif /* LAPACK_H */

360
relapack/src/lapack_wrappers.c
View File

@ -6,9 +6,9 @@
#if INCLUDE_SLAUUM #if INCLUDE_SLAUUM
void LAPACK(slauum)( void LAPACK(slauum)(
const char *uplo, const int *n, const char *uplo, const blasint *n,
float *A, const int *ldA, float *A, const blasint *ldA,
int *info blasint *info
) { ) {
RELAPACK_slauum(uplo, n, A, ldA, info); RELAPACK_slauum(uplo, n, A, ldA, info);
} }
@ -16,9 +16,9 @@ void LAPACK(slauum)(
#if INCLUDE_DLAUUM #if INCLUDE_DLAUUM
void LAPACK(dlauum)( void LAPACK(dlauum)(
const char *uplo, const int *n, const char *uplo, const blasint *n,
double *A, const int *ldA, double *A, const blasint *ldA,
int *info blasint *info
) { ) {
RELAPACK_dlauum(uplo, n, A, ldA, info); RELAPACK_dlauum(uplo, n, A, ldA, info);
} }
@ -26,9 +26,9 @@ void LAPACK(dlauum)(
#if INCLUDE_CLAUUM #if INCLUDE_CLAUUM
void LAPACK(clauum)( void LAPACK(clauum)(
const char *uplo, const int *n, const char *uplo, const blasint *n,
float *A, const int *ldA, float *A, const blasint *ldA,
int *info blasint *info
) { ) {
RELAPACK_clauum(uplo, n, A, ldA, info); RELAPACK_clauum(uplo, n, A, ldA, info);
} }
@ -36,9 +36,9 @@ void LAPACK(clauum)(
#if INCLUDE_ZLAUUM #if INCLUDE_ZLAUUM
void LAPACK(zlauum)( void LAPACK(zlauum)(
const char *uplo, const int *n, const char *uplo, const blasint *n,
double *A, const int *ldA, double *A, const blasint *ldA,
int *info blasint *info
) { ) {
RELAPACK_zlauum(uplo, n, A, ldA, info); RELAPACK_zlauum(uplo, n, A, ldA, info);
} }
@ -51,9 +51,9 @@ void LAPACK(zlauum)(
#if INCLUDE_SSYGST #if INCLUDE_SSYGST
void LAPACK(ssygst)( void LAPACK(ssygst)(
const int *itype, const char *uplo, const int *n, const blasint *itype, const char *uplo, const blasint *n,
float *A, const int *ldA, const float *B, const int *ldB, float *A, const blasint *ldA, const float *B, const blasint *ldB,
int *info blasint *info
) { ) {
RELAPACK_ssygst(itype, uplo, n, A, ldA, B, ldB, info); RELAPACK_ssygst(itype, uplo, n, A, ldA, B, ldB, info);
} }
@ -61,9 +61,9 @@ void LAPACK(ssygst)(
#if INCLUDE_DSYGST #if INCLUDE_DSYGST
void LAPACK(dsygst)( void LAPACK(dsygst)(
const int *itype, const char *uplo, const int *n, const blasint *itype, const char *uplo, const blasint *n,
double *A, const int *ldA, const double *B, const int *ldB, double *A, const blasint *ldA, const double *B, const blasint *ldB,
int *info blasint *info
) { ) {
RELAPACK_dsygst(itype, uplo, n, A, ldA, B, ldB, info); RELAPACK_dsygst(itype, uplo, n, A, ldA, B, ldB, info);
} }
@ -71,9 +71,9 @@ void LAPACK(dsygst)(
#if INCLUDE_CHEGST #if INCLUDE_CHEGST
void LAPACK(chegst)( void LAPACK(chegst)(
const int *itype, const char *uplo, const int *n, const blasint *itype, const char *uplo, const blasint *n,
float *A, const int *ldA, const float *B, const int *ldB, float *A, const blasint *ldA, const float *B, const blasint *ldB,
int *info blasint *info
) { ) {
RELAPACK_chegst(itype, uplo, n, A, ldA, B, ldB, info); RELAPACK_chegst(itype, uplo, n, A, ldA, B, ldB, info);
} }
@ -81,9 +81,9 @@ void LAPACK(chegst)(
#if INCLUDE_ZHEGST #if INCLUDE_ZHEGST
void LAPACK(zhegst)( void LAPACK(zhegst)(
const int *itype, const char *uplo, const int *n, const blasint *itype, const char *uplo, const blasint *n,
double *A, const int *ldA, const double *B, const int *ldB, double *A, const blasint *ldA, const double *B, const blasint *ldB,
int *info blasint *info
) { ) {
RELAPACK_zhegst(itype, uplo, n, A, ldA, B, ldB, info); RELAPACK_zhegst(itype, uplo, n, A, ldA, B, ldB, info);
} }
@ -96,9 +96,9 @@ void LAPACK(zhegst)(
#if INCLUDE_STRTRI #if INCLUDE_STRTRI
void LAPACK(strtri)( void LAPACK(strtri)(
const char *uplo, const char *diag, const int *n, const char *uplo, const char *diag, const blasint *n,
float *A, const int *ldA, float *A, const blasint *ldA,
int *info blasint *info
) { ) {
RELAPACK_strtri(uplo, diag, n, A, ldA, info); RELAPACK_strtri(uplo, diag, n, A, ldA, info);
} }
@ -106,9 +106,9 @@ void LAPACK(strtri)(
#if INCLUDE_DTRTRI #if INCLUDE_DTRTRI
void LAPACK(dtrtri)( void LAPACK(dtrtri)(
const char *uplo, const char *diag, const int *n, const char *uplo, const char *diag, const blasint *n,
double *A, const int *ldA, double *A, const blasint *ldA,
int *info blasint *info
) { ) {
RELAPACK_dtrtri(uplo, diag, n, A, ldA, info); RELAPACK_dtrtri(uplo, diag, n, A, ldA, info);
} }
@ -116,9 +116,9 @@ void LAPACK(dtrtri)(
#if INCLUDE_CTRTRI #if INCLUDE_CTRTRI
void LAPACK(ctrtri)( void LAPACK(ctrtri)(
const char *uplo, const char *diag, const int *n, const char *uplo, const char *diag, const blasint *n,
float *A, const int *ldA, float *A, const blasint *ldA,
int *info blasint *info
) { ) {
RELAPACK_ctrtri(uplo, diag, n, A, ldA, info); RELAPACK_ctrtri(uplo, diag, n, A, ldA, info);
} }
@ -126,9 +126,9 @@ void LAPACK(ctrtri)(
#if INCLUDE_ZTRTRI #if INCLUDE_ZTRTRI
void LAPACK(ztrtri)( void LAPACK(ztrtri)(
const char *uplo, const char *diag, const int *n, const char *uplo, const char *diag, const blasint *n,
double *A, const int *ldA, double *A, const blasint *ldA,
int *info blasint *info
) { ) {
RELAPACK_ztrtri(uplo, diag, n, A, ldA, info); RELAPACK_ztrtri(uplo, diag, n, A, ldA, info);
} }
@ -141,9 +141,9 @@ void LAPACK(ztrtri)(
#if INCLUDE_SPOTRF #if INCLUDE_SPOTRF
void LAPACK(spotrf)( void LAPACK(spotrf)(
const char *uplo, const int *n, const char *uplo, const blasint *n,
float *A, const int *ldA, float *A, const blasint *ldA,
int *info blasint *info
) { ) {
RELAPACK_spotrf(uplo, n, A, ldA, info); RELAPACK_spotrf(uplo, n, A, ldA, info);
} }
@ -151,9 +151,9 @@ void LAPACK(spotrf)(
#if INCLUDE_DPOTRF #if INCLUDE_DPOTRF
void LAPACK(dpotrf)( void LAPACK(dpotrf)(
const char *uplo, const int *n, const char *uplo, const blasint *n,
double *A, const int *ldA, double *A, const blasint *ldA,
int *info blasint *info
) { ) {
RELAPACK_dpotrf(uplo, n, A, ldA, info); RELAPACK_dpotrf(uplo, n, A, ldA, info);
} }
@ -161,9 +161,9 @@ void LAPACK(dpotrf)(
#if INCLUDE_CPOTRF #if INCLUDE_CPOTRF
void LAPACK(cpotrf)( void LAPACK(cpotrf)(
const char *uplo, const int *n, const char *uplo, const blasint *n,
float *A, const int *ldA, float *A, const blasint *ldA,
int *info blasint *info
) { ) {
RELAPACK_cpotrf(uplo, n, A, ldA, info); RELAPACK_cpotrf(uplo, n, A, ldA, info);
} }
@ -171,9 +171,9 @@ void LAPACK(cpotrf)(
#if INCLUDE_ZPOTRF #if INCLUDE_ZPOTRF
void LAPACK(zpotrf)( void LAPACK(zpotrf)(
const char *uplo, const int *n, const char *uplo, const blasint *n,
double *A, const int *ldA, double *A, const blasint *ldA,
int *info blasint *info
) { ) {
RELAPACK_zpotrf(uplo, n, A, ldA, info); RELAPACK_zpotrf(uplo, n, A, ldA, info);
} }
@ -186,9 +186,9 @@ void LAPACK(zpotrf)(
#if INCLUDE_SPBTRF #if INCLUDE_SPBTRF
void LAPACK(spbtrf)( void LAPACK(spbtrf)(
const char *uplo, const int *n, const int *kd, const char *uplo, const blasint *n, const blasint *kd,
float *Ab, const int *ldAb, float *Ab, const blasint *ldAb,
int *info blasint *info
) { ) {
RELAPACK_spbtrf(uplo, n, kd, Ab, ldAb, info); RELAPACK_spbtrf(uplo, n, kd, Ab, ldAb, info);
} }
@ -196,9 +196,9 @@ void LAPACK(spbtrf)(
#if INCLUDE_DPBTRF #if INCLUDE_DPBTRF
void LAPACK(dpbtrf)( void LAPACK(dpbtrf)(
const char *uplo, const int *n, const int *kd, const char *uplo, const blasint *n, const blasint *kd,
double *Ab, const int *ldAb, double *Ab, const blasint *ldAb,
int *info blasint *info
) { ) {
RELAPACK_dpbtrf(uplo, n, kd, Ab, ldAb, info); RELAPACK_dpbtrf(uplo, n, kd, Ab, ldAb, info);
} }
@ -206,9 +206,9 @@ void LAPACK(dpbtrf)(
#if INCLUDE_CPBTRF #if INCLUDE_CPBTRF
void LAPACK(cpbtrf)( void LAPACK(cpbtrf)(
const char *uplo, const int *n, const int *kd, const char *uplo, const blasint *n, const blasint *kd,
float *Ab, const int *ldAb, float *Ab, const blasint *ldAb,
int *info blasint *info
) { ) {
RELAPACK_cpbtrf(uplo, n, kd, Ab, ldAb, info); RELAPACK_cpbtrf(uplo, n, kd, Ab, ldAb, info);
} }
@ -216,9 +216,9 @@ void LAPACK(cpbtrf)(
#if INCLUDE_ZPBTRF #if INCLUDE_ZPBTRF
void LAPACK(zpbtrf)( void LAPACK(zpbtrf)(
const char *uplo, const int *n, const int *kd, const char *uplo, const blasint *n, const blasint *kd,
double *Ab, const int *ldAb, double *Ab, const blasint *ldAb,
int *info blasint *info
) { ) {
RELAPACK_zpbtrf(uplo, n, kd, Ab, ldAb, info); RELAPACK_zpbtrf(uplo, n, kd, Ab, ldAb, info);
} }
@ -231,9 +231,9 @@ void LAPACK(zpbtrf)(
#if INCLUDE_SSYTRF #if INCLUDE_SSYTRF
void LAPACK(ssytrf)( void LAPACK(ssytrf)(
const char *uplo, const int *n, const char *uplo, const blasint *n,
float *A, const int *ldA, int *ipiv, float *A, const blasint *ldA, blasint *ipiv,
float *Work, const int *lWork, int *info float *Work, const blasint *lWork, blasint *info
) { ) {
RELAPACK_ssytrf(uplo, n, A, ldA, ipiv, Work, lWork, info); RELAPACK_ssytrf(uplo, n, A, ldA, ipiv, Work, lWork, info);
} }
@ -241,9 +241,9 @@ void LAPACK(ssytrf)(
#if INCLUDE_DSYTRF #if INCLUDE_DSYTRF
void LAPACK(dsytrf)( void LAPACK(dsytrf)(
const char *uplo, const int *n, const char *uplo, const blasint *n,
double *A, const int *ldA, int *ipiv, double *A, const blasint *ldA, blasint *ipiv,
double *Work, const int *lWork, int *info double *Work, const blasint *lWork, blasint *info
) { ) {
RELAPACK_dsytrf(uplo, n, A, ldA, ipiv, Work, lWork, info); RELAPACK_dsytrf(uplo, n, A, ldA, ipiv, Work, lWork, info);
} }
@ -251,9 +251,9 @@ void LAPACK(dsytrf)(
#if INCLUDE_CSYTRF #if INCLUDE_CSYTRF
void LAPACK(csytrf)( void LAPACK(csytrf)(
const char *uplo, const int *n, const char *uplo, const blasint *n,
float *A, const int *ldA, int *ipiv, float *A, const blasint *ldA, blasint *ipiv,
float *Work, const int *lWork, int *info float *Work, const blasint *lWork, blasint *info
) { ) {
RELAPACK_csytrf(uplo, n, A, ldA, ipiv, Work, lWork, info); RELAPACK_csytrf(uplo, n, A, ldA, ipiv, Work, lWork, info);
} }
@ -261,9 +261,9 @@ void LAPACK(csytrf)(
#if INCLUDE_ZSYTRF #if INCLUDE_ZSYTRF
void LAPACK(zsytrf)( void LAPACK(zsytrf)(
const char *uplo, const int *n, const char *uplo, const blasint *n,
double *A, const int *ldA, int *ipiv, double *A, const blasint *ldA, blasint *ipiv,
double *Work, const int *lWork, int *info double *Work, const blasint *lWork, blasint *info
) { ) {
RELAPACK_zsytrf(uplo, n, A, ldA, ipiv, Work, lWork, info); RELAPACK_zsytrf(uplo, n, A, ldA, ipiv, Work, lWork, info);
} }
@ -271,9 +271,9 @@ void LAPACK(zsytrf)(
#if INCLUDE_CHETRF #if INCLUDE_CHETRF
void LAPACK(chetrf)( void LAPACK(chetrf)(
const char *uplo, const int *n, const char *uplo, const blasint *n,
float *A, const int *ldA, int *ipiv, float *A, const blasint *ldA, blasint *ipiv,
float *Work, const int *lWork, int *info float *Work, const blasint *lWork, blasint *info
) { ) {
RELAPACK_chetrf(uplo, n, A, ldA, ipiv, Work, lWork, info); RELAPACK_chetrf(uplo, n, A, ldA, ipiv, Work, lWork, info);
} }
@ -281,9 +281,9 @@ void LAPACK(chetrf)(
#if INCLUDE_ZHETRF #if INCLUDE_ZHETRF
void LAPACK(zhetrf)( void LAPACK(zhetrf)(
const char *uplo, const int *n, const char *uplo, const blasint *n,
double *A, const int *ldA, int *ipiv, double *A, const blasint *ldA, blasint *ipiv,
double *Work, const int *lWork, int *info double *Work, const blasint *lWork, blasint *info
) { ) {
RELAPACK_zhetrf(uplo, n, A, ldA, ipiv, Work, lWork, info); RELAPACK_zhetrf(uplo, n, A, ldA, ipiv, Work, lWork, info);
} }
@ -291,9 +291,9 @@ void LAPACK(zhetrf)(
#if INCLUDE_SSYTRF_ROOK #if INCLUDE_SSYTRF_ROOK
void LAPACK(ssytrf_rook)( void LAPACK(ssytrf_rook)(
const char *uplo, const int *n, const char *uplo, const blasint *n,
float *A, const int *ldA, int *ipiv, float *A, const blasint *ldA, blasint *ipiv,
float *Work, const int *lWork, int *info float *Work, const blasint *lWork, blasint *info
) { ) {
RELAPACK_ssytrf_rook(uplo, n, A, ldA, ipiv, Work, lWork, info); RELAPACK_ssytrf_rook(uplo, n, A, ldA, ipiv, Work, lWork, info);
} }
@ -301,9 +301,9 @@ void LAPACK(ssytrf_rook)(
#if INCLUDE_DSYTRF_ROOK #if INCLUDE_DSYTRF_ROOK
void LAPACK(dsytrf_rook)( void LAPACK(dsytrf_rook)(
const char *uplo, const int *n, const char *uplo, const blasint *n,
double *A, const int *ldA, int *ipiv, double *A, const blasint *ldA, blasint *ipiv,
double *Work, const int *lWork, int *info double *Work, const blasint *lWork, blasint *info
) { ) {
RELAPACK_dsytrf_rook(uplo, n, A, ldA, ipiv, Work, lWork, info); RELAPACK_dsytrf_rook(uplo, n, A, ldA, ipiv, Work, lWork, info);
} }
@ -311,9 +311,9 @@ void LAPACK(dsytrf_rook)(
#if INCLUDE_CSYTRF_ROOK #if INCLUDE_CSYTRF_ROOK
void LAPACK(csytrf_rook)( void LAPACK(csytrf_rook)(
const char *uplo, const int *n, const char *uplo, const blasint *n,
float *A, const int *ldA, int *ipiv, float *A, const blasint *ldA, blasint *ipiv,
float *Work, const int *lWork, int *info float *Work, const blasint *lWork, blasint *info
) { ) {
RELAPACK_csytrf_rook(uplo, n, A, ldA, ipiv, Work, lWork, info); RELAPACK_csytrf_rook(uplo, n, A, ldA, ipiv, Work, lWork, info);
} }
@ -321,9 +321,9 @@ void LAPACK(csytrf_rook)(
#if INCLUDE_ZSYTRF_ROOK #if INCLUDE_ZSYTRF_ROOK
void LAPACK(zsytrf_rook)( void LAPACK(zsytrf_rook)(
const char *uplo, const int *n, const char *uplo, const blasint *n,
double *A, const int *ldA, int *ipiv, double *A, const blasint *ldA, blasint *ipiv,
double *Work, const int *lWork, int *info double *Work, const blasint *lWork, blasint *info
) { ) {
RELAPACK_zsytrf_rook(uplo, n, A, ldA, ipiv, Work, lWork, info); RELAPACK_zsytrf_rook(uplo, n, A, ldA, ipiv, Work, lWork, info);
} }
@ -331,9 +331,9 @@ void LAPACK(zsytrf_rook)(
#if INCLUDE_CHETRF_ROOK #if INCLUDE_CHETRF_ROOK
void LAPACK(chetrf_rook)( void LAPACK(chetrf_rook)(
const char *uplo, const int *n, const char *uplo, const blasint *n,
float *A, const int *ldA, int *ipiv, float *A, const blasint *ldA, blasint *ipiv,
float *Work, const int *lWork, int *info float *Work, const blasint *lWork, blasint *info
) { ) {
RELAPACK_chetrf_rook(uplo, n, A, ldA, ipiv, Work, lWork, info); RELAPACK_chetrf_rook(uplo, n, A, ldA, ipiv, Work, lWork, info);
} }
@ -341,9 +341,9 @@ void LAPACK(chetrf_rook)(
#if INCLUDE_ZHETRF_ROOK #if INCLUDE_ZHETRF_ROOK
void LAPACK(zhetrf_rook)( void LAPACK(zhetrf_rook)(
const char *uplo, const int *n, const char *uplo, const blasint *n,
double *A, const int *ldA, int *ipiv, double *A, const blasint *ldA, blasint *ipiv,
double *Work, const int *lWork, int *info double *Work, const blasint *lWork, blasint *info
) { ) {
RELAPACK_zhetrf_rook(uplo, n, A, ldA, ipiv, Work, lWork, info); RELAPACK_zhetrf_rook(uplo, n, A, ldA, ipiv, Work, lWork, info);
} }
@ -356,9 +356,9 @@ void LAPACK(zhetrf_rook)(
#if INCLUDE_SGETRF #if INCLUDE_SGETRF
void LAPACK(sgetrf)( void LAPACK(sgetrf)(
const int *m, const int *n, const blasint *m, const blasint *n,
float *A, const int *ldA, int *ipiv, float *A, const blasint *ldA, blasint *ipiv,
int *info blasint *info
) { ) {
RELAPACK_sgetrf(m, n, A, ldA, ipiv, info); RELAPACK_sgetrf(m, n, A, ldA, ipiv, info);
} }
@ -366,9 +366,9 @@ void LAPACK(sgetrf)(
#if INCLUDE_DGETRF #if INCLUDE_DGETRF
void LAPACK(dgetrf)( void LAPACK(dgetrf)(
const int *m, const int *n, const blasint *m, const blasint *n,
double *A, const int *ldA, int *ipiv, double *A, const blasint *ldA, blasint *ipiv,
int *info blasint *info
) { ) {
RELAPACK_dgetrf(m, n, A, ldA, ipiv, info); RELAPACK_dgetrf(m, n, A, ldA, ipiv, info);
} }
@ -376,9 +376,9 @@ void LAPACK(dgetrf)(
#if INCLUDE_CGETRF #if INCLUDE_CGETRF
void LAPACK(cgetrf)( void LAPACK(cgetrf)(
const int *m, const int *n, const blasint *m, const blasint *n,
float *A, const int *ldA, int *ipiv, float *A, const blasint *ldA, blasint *ipiv,
int *info blasint *info
) { ) {
RELAPACK_cgetrf(m, n, A, ldA, ipiv, info); RELAPACK_cgetrf(m, n, A, ldA, ipiv, info);
} }
@ -386,9 +386,9 @@ void LAPACK(cgetrf)(
#if INCLUDE_ZGETRF #if INCLUDE_ZGETRF
void LAPACK(zgetrf)( void LAPACK(zgetrf)(
const int *m, const int *n, const blasint *m, const blasint *n,
double *A, const int *ldA, int *ipiv, double *A, const blasint *ldA, blasint *ipiv,
int *info blasint *info
) { ) {
RELAPACK_zgetrf(m, n, A, ldA, ipiv, info); RELAPACK_zgetrf(m, n, A, ldA, ipiv, info);
} }
@ -401,9 +401,9 @@ void LAPACK(zgetrf)(
#if INCLUDE_SGBTRF #if INCLUDE_SGBTRF
void LAPACK(sgbtrf)( void LAPACK(sgbtrf)(
const int *m, const int *n, const int *kl, const int *ku, const blasint *m, const blasint *n, const blasint *kl, const blasint *ku,
float *Ab, const int *ldAb, int *ipiv, float *Ab, const blasint *ldAb, blasint *ipiv,
int *info blasint *info
) { ) {
RELAPACK_sgbtrf(m, n, kl, ku, Ab, ldAb, ipiv, info); RELAPACK_sgbtrf(m, n, kl, ku, Ab, ldAb, ipiv, info);
} }
@ -411,9 +411,9 @@ void LAPACK(sgbtrf)(
#if INCLUDE_DGBTRF #if INCLUDE_DGBTRF
void LAPACK(dgbtrf)( void LAPACK(dgbtrf)(
const int *m, const int *n, const int *kl, const int *ku, const blasint *m, const blasint *n, const blasint *kl, const blasint *ku,
double *Ab, const int *ldAb, int *ipiv, double *Ab, const blasint *ldAb, blasint *ipiv,
int *info blasint *info
) { ) {
RELAPACK_dgbtrf(m, n, kl, ku, Ab, ldAb, ipiv, info); RELAPACK_dgbtrf(m, n, kl, ku, Ab, ldAb, ipiv, info);
} }
@ -421,9 +421,9 @@ void LAPACK(dgbtrf)(
#if INCLUDE_CGBTRF #if INCLUDE_CGBTRF
void LAPACK(cgbtrf)( void LAPACK(cgbtrf)(
const int *m, const int *n, const int *kl, const int *ku, const blasint *m, const blasint *n, const blasint *kl, const blasint *ku,
float *Ab, const int *ldAb, int *ipiv, float *Ab, const blasint *ldAb, blasint *ipiv,
int *info blasint *info
) { ) {
RELAPACK_cgbtrf(m, n, kl, ku, Ab, ldAb, ipiv, info); RELAPACK_cgbtrf(m, n, kl, ku, Ab, ldAb, ipiv, info);
} }
@ -431,9 +431,9 @@ void LAPACK(cgbtrf)(
#if INCLUDE_ZGBTRF #if INCLUDE_ZGBTRF
void LAPACK(zgbtrf)( void LAPACK(zgbtrf)(
const int *m, const int *n, const int *kl, const int *ku, const blasint *m, const blasint *n, const blasint *kl, const blasint *ku,
double *Ab, const int *ldAb, int *ipiv, double *Ab, const blasint *ldAb, blasint *ipiv,
int *info blasint *info
) { ) {
RELAPACK_zgbtrf(m, n, kl, ku, Ab, ldAb, ipiv, info); RELAPACK_zgbtrf(m, n, kl, ku, Ab, ldAb, ipiv, info);
} }
@ -446,11 +446,11 @@ void LAPACK(zgbtrf)(
#if INCLUDE_STRSYL #if INCLUDE_STRSYL
void LAPACK(strsyl)( void LAPACK(strsyl)(
const char *tranA, const char *tranB, const int *isgn, const char *tranA, const char *tranB, const blasint *isgn,
const int *m, const int *n, const blasint *m, const blasint *n,
const float *A, const int *ldA, const float *B, const int *ldB, const float *A, const blasint *ldA, const float *B, const blasint *ldB,
float *C, const int *ldC, float *scale, float *C, const blasint *ldC, float *scale,
int *info blasint *info
) { ) {
RELAPACK_strsyl(tranA, tranB, isgn, m, n, A, ldA, B, ldB, C, ldC, scale, info); RELAPACK_strsyl(tranA, tranB, isgn, m, n, A, ldA, B, ldB, C, ldC, scale, info);
} }
@ -458,11 +458,11 @@ void LAPACK(strsyl)(
#if INCLUDE_DTRSYL #if INCLUDE_DTRSYL
void LAPACK(dtrsyl)( void LAPACK(dtrsyl)(
const char *tranA, const char *tranB, const int *isgn, const char *tranA, const char *tranB, const blasint *isgn,
const int *m, const int *n, const blasint *m, const blasint *n,
const double *A, const int *ldA, const double *B, const int *ldB, const double *A, const blasint *ldA, const double *B, const blasint *ldB,
double *C, const int *ldC, double *scale, double *C, const blasint *ldC, double *scale,
int *info blasint *info
) { ) {
RELAPACK_dtrsyl(tranA, tranB, isgn, m, n, A, ldA, B, ldB, C, ldC, scale, info); RELAPACK_dtrsyl(tranA, tranB, isgn, m, n, A, ldA, B, ldB, C, ldC, scale, info);
} }
@ -470,11 +470,11 @@ void LAPACK(dtrsyl)(
#if INCLUDE_CTRSYL #if INCLUDE_CTRSYL
void LAPACK(ctrsyl)( void LAPACK(ctrsyl)(
const char *tranA, const char *tranB, const int *isgn, const char *tranA, const char *tranB, const blasint *isgn,
const int *m, const int *n, const blasint *m, const blasint *n,
const float *A, const int *ldA, const float *B, const int *ldB, const float *A, const blasint *ldA, const float *B, const blasint *ldB,
float *C, const int *ldC, float *scale, float *C, const blasint *ldC, float *scale,
int *info blasint *info
) { ) {
RELAPACK_ctrsyl(tranA, tranB, isgn, m, n, A, ldA, B, ldB, C, ldC, scale, info); RELAPACK_ctrsyl(tranA, tranB, isgn, m, n, A, ldA, B, ldB, C, ldC, scale, info);
} }
@ -482,11 +482,11 @@ void LAPACK(ctrsyl)(
#if INCLUDE_ZTRSYL #if INCLUDE_ZTRSYL
void LAPACK(ztrsyl)( void LAPACK(ztrsyl)(
const char *tranA, const char *tranB, const int *isgn, const char *tranA, const char *tranB, const blasint *isgn,
const int *m, const int *n, const blasint *m, const blasint *n,
const double *A, const int *ldA, const double *B, const int *ldB, const double *A, const blasint *ldA, const double *B, const blasint *ldB,
double *C, const int *ldC, double *scale, double *C, const blasint *ldC, double *scale,
int *info blasint *info
) { ) {
RELAPACK_ztrsyl(tranA, tranB, isgn, m, n, A, ldA, B, ldB, C, ldC, scale, info); RELAPACK_ztrsyl(tranA, tranB, isgn, m, n, A, ldA, B, ldB, C, ldC, scale, info);
} }
@ -499,13 +499,13 @@ void LAPACK(ztrsyl)(
#if INCLUDE_STGSYL #if INCLUDE_STGSYL
void LAPACK(stgsyl)( void LAPACK(stgsyl)(
const char *trans, const int *ijob, const int *m, const int *n, const char *trans, const blasint *ijob, const blasint *m, const blasint *n,
const float *A, const int *ldA, const float *B, const int *ldB, const float *A, const blasint *ldA, const float *B, const blasint *ldB,
float *C, const int *ldC, float *C, const blasint *ldC,
const float *D, const int *ldD, const float *E, const int *ldE, const float *D, const blasint *ldD, const float *E, const blasint *ldE,
float *F, const int *ldF, float *F, const blasint *ldF,
float *scale, float *dif, float *scale, float *dif,
float *Work, const int *lWork, int *iWork, int *info float *Work, const blasint *lWork, blasint *iWork, blasint *info
) { ) {
RELAPACK_stgsyl(trans, ijob, m, n, A, ldA, B, ldB, C, ldC, D, ldD, E, ldE, F, ldF, scale, dif, Work, lWork, iWork, info); RELAPACK_stgsyl(trans, ijob, m, n, A, ldA, B, ldB, C, ldC, D, ldD, E, ldE, F, ldF, scale, dif, Work, lWork, iWork, info);
} }
@ -513,13 +513,13 @@ void LAPACK(stgsyl)(
#if INCLUDE_DTGSYL #if INCLUDE_DTGSYL
void LAPACK(dtgsyl)( void LAPACK(dtgsyl)(
const char *trans, const int *ijob, const int *m, const int *n, const char *trans, const blasint *ijob, const blasint *m, const blasint *n,
const double *A, const int *ldA, const double *B, const int *ldB, const double *A, const blasint *ldA, const double *B, const blasint *ldB,
double *C, const int *ldC, double *C, const blasint *ldC,
const double *D, const int *ldD, const double *E, const int *ldE, const double *D, const blasint *ldD, const double *E, const blasint *ldE,
double *F, const int *ldF, double *F, const blasint *ldF,
double *scale, double *dif, double *scale, double *dif,
double *Work, const int *lWork, int *iWork, int *info double *Work, const blasint *lWork, blasint *iWork, blasint *info
) { ) {
RELAPACK_dtgsyl(trans, ijob, m, n, A, ldA, B, ldB, C, ldC, D, ldD, E, ldE, F, ldF, scale, dif, Work, lWork, iWork, info); RELAPACK_dtgsyl(trans, ijob, m, n, A, ldA, B, ldB, C, ldC, D, ldD, E, ldE, F, ldF, scale, dif, Work, lWork, iWork, info);
} }
@ -527,13 +527,13 @@ void LAPACK(dtgsyl)(
#if INCLUDE_CTGSYL #if INCLUDE_CTGSYL
void LAPACK(ctgsyl)( void LAPACK(ctgsyl)(
const char *trans, const int *ijob, const int *m, const int *n, const char *trans, const blasint *ijob, const blasint *m, const blasint *n,
const float *A, const int *ldA, const float *B, const int *ldB, const float *A, const blasint *ldA, const float *B, const blasint *ldB,
float *C, const int *ldC, float *C, const blasint *ldC,
const float *D, const int *ldD, const float *E, const int *ldE, const float *D, const blasint *ldD, const float *E, const blasint *ldE,
float *F, const int *ldF, float *F, const blasint *ldF,
float *scale, float *dif, float *scale, float *dif,
float *Work, const int *lWork, int *iWork, int *info float *Work, const blasint *lWork, blasint *iWork, blasint *info
) { ) {
RELAPACK_ctgsyl(trans, ijob, m, n, A, ldA, B, ldB, C, ldC, D, ldD, E, ldE, F, ldF, scale, dif, Work, lWork, iWork, info); RELAPACK_ctgsyl(trans, ijob, m, n, A, ldA, B, ldB, C, ldC, D, ldD, E, ldE, F, ldF, scale, dif, Work, lWork, iWork, info);
} }
@ -541,13 +541,13 @@ void LAPACK(ctgsyl)(
#if INCLUDE_ZTGSYL #if INCLUDE_ZTGSYL
void LAPACK(ztgsyl)( void LAPACK(ztgsyl)(
const char *trans, const int *ijob, const int *m, const int *n, const char *trans, const blasint *ijob, const blasint *m, const blasint *n,
const double *A, const int *ldA, const double *B, const int *ldB, const double *A, const blasint *ldA, const double *B, const blasint *ldB,
double *C, const int *ldC, double *C, const blasint *ldC,
const double *D, const int *ldD, const double *E, const int *ldE, const double *D, const blasint *ldD, const double *E, const blasint *ldE,
double *F, const int *ldF, double *F, const blasint *ldF,
double *scale, double *dif, double *scale, double *dif,
double *Work, const int *lWork, int *iWork, int *info double *Work, const blasint *lWork, blasint *iWork, blasint *info
) { ) {
RELAPACK_ztgsyl(trans, ijob, m, n, A, ldA, B, ldB, C, ldC, D, ldD, E, ldE, F, ldF, scale, dif, Work, lWork, iWork, info); RELAPACK_ztgsyl(trans, ijob, m, n, A, ldA, B, ldB, C, ldC, D, ldD, E, ldE, F, ldF, scale, dif, Work, lWork, iWork, info);
} }
@ -561,10 +561,10 @@ void LAPACK(ztgsyl)(
#if INCLUDE_SGEMMT #if INCLUDE_SGEMMT
void LAPACK(sgemmt)( void LAPACK(sgemmt)(
const char *uplo, const char *transA, const char *transB, const char *uplo, const char *transA, const char *transB,
const int *n, const int *k, const blasint *n, const blasint *k,
const float *alpha, const float *A, const int *ldA, const float *alpha, const float *A, const blasint *ldA,
const float *B, const int *ldB, const float *B, const blasint *ldB,
const float *beta, float *C, const int *ldC const float *beta, float *C, const blasint *ldC
) { ) {
RELAPACK_sgemmt(uplo, n, A, ldA, info); RELAPACK_sgemmt(uplo, n, A, ldA, info);
} }
@ -573,10 +573,10 @@ void LAPACK(sgemmt)(
#if INCLUDE_DGEMMT #if INCLUDE_DGEMMT
void LAPACK(dgemmt)( void LAPACK(dgemmt)(
const char *uplo, const char *transA, const char *transB, const char *uplo, const char *transA, const char *transB,
const int *n, const int *k, const blasint *n, const blasint *k,
const double *alpha, const double *A, const int *ldA, const double *alpha, const double *A, const blasint *ldA,
const double *B, const int *ldB, const double *B, const blasint *ldB,
const double *beta, double *C, const int *ldC const double *beta, double *C, const blasint *ldC
) { ) {
RELAPACK_dgemmt(uplo, n, A, ldA, info); RELAPACK_dgemmt(uplo, n, A, ldA, info);
} }
@ -585,10 +585,10 @@ void LAPACK(dgemmt)(
#if INCLUDE_CGEMMT #if INCLUDE_CGEMMT
void LAPACK(cgemmt)( void LAPACK(cgemmt)(
const char *uplo, const char *transA, const char *transB, const char *uplo, const char *transA, const char *transB,
const int *n, const int *k, const blasint *n, const blasint *k,
const float *alpha, const float *A, const int *ldA, const float *alpha, const float *A, const blasint *ldA,
const float *B, const int *ldB, const float *B, const blasint *ldB,
const float *beta, float *C, const int *ldC const float *beta, float *C, const blasint *ldC
) { ) {
RELAPACK_cgemmt(uplo, n, A, ldA, info); RELAPACK_cgemmt(uplo, n, A, ldA, info);
} }
@ -597,10 +597,10 @@ void LAPACK(cgemmt)(
#if INCLUDE_ZGEMMT #if INCLUDE_ZGEMMT
void LAPACK(zgemmt)( void LAPACK(zgemmt)(
const char *uplo, const char *transA, const char *transB, const char *uplo, const char *transA, const char *transB,
const int *n, const int *k, const blasint *n, const blasint *k,
const double *alpha, const double *A, const int *ldA, const double *alpha, const double *A, const blasint *ldA,
const double *B, const int *ldB, const double *B, const blasint *ldB,
const double *beta, double *C, const int *ldC const double *beta, double *C, const blasint *ldC
) { ) {
RELAPACK_zgemmt(uplo, n, A, ldA, info); RELAPACK_zgemmt(uplo, n, A, ldA, info);
} }

42
relapack/src/relapack.h
View File

@ -1,6 +1,14 @@
#ifndef RELAPACK_INT_H #ifndef RELAPACK_INT_H
#define RELAPACK_INT_H #define RELAPACK_INT_H
#include <string.h>
#include "../../config.h"
#if defined(OS_WINDOWS) && defined(__64BIT__)
typedef long long BLASLONG;
typedef unsigned long long BLASULONG;
#else
typedef long BLASLONG;
typedef unsigned long BLASULONG;
#endif
#include "../config.h" #include "../config.h"
#include "../inc/relapack.h" #include "../inc/relapack.h"
@ -38,23 +46,23 @@
#include "blas.h" #include "blas.h"
// sytrf helper routines // sytrf helper routines
void RELAPACK_ssytrf_rec2(const char *, const int *, const int *, int *, float *, const int *, int *, float *, const int *, int *); void RELAPACK_ssytrf_rec2(const char *, const blasint *, const blasint *, blasint *, float *, const blasint *, blasint *, float *, const blasint *, blasint *);
void RELAPACK_dsytrf_rec2(const char *, const int *, const int *, int *, double *, const int *, int *, double *, const int *, int *); void RELAPACK_dsytrf_rec2(const char *, const blasint *, const blasint *, blasint *, double *, const blasint *, blasint *, double *, const blasint *, blasint *);
void RELAPACK_csytrf_rec2(const char *, const int *, const int *, int *, float *, const int *, int *, float *, const int *, int *); void RELAPACK_csytrf_rec2(const char *, const blasint *, const blasint *, blasint *, float *, const blasint *, blasint *, float *, const blasint *, blasint *);
void RELAPACK_chetrf_rec2(const char *, const int *, const int *, int *, float *, const int *, int *, float *, const int *, int *); void RELAPACK_chetrf_rec2(const char *, const blasint *, const blasint *, blasint *, float *, const blasint *, blasint *, float *, const blasint *, blasint *);
void RELAPACK_zsytrf_rec2(const char *, const int *, const int *, int *, double *, const int *, int *, double *, const int *, int *); void RELAPACK_zsytrf_rec2(const char *, const blasint *, const blasint *, blasint *, double *, const blasint *, blasint *, double *, const blasint *, blasint *);
void RELAPACK_zhetrf_rec2(const char *, const int *, const int *, int *, double *, const int *, int *, double *, const int *, int *); void RELAPACK_zhetrf_rec2(const char *, const blasint *, const blasint *, blasint *, double *, const blasint *, blasint *, double *, const blasint *, blasint *);
void RELAPACK_ssytrf_rook_rec2(const char *, const int *, const int *, int *, float *, const int *, int *, float *, const int *, int *); void RELAPACK_ssytrf_rook_rec2(const char *, const blasint *, const blasint *, blasint *, float *, const blasint *, blasint *, float *, const blasint *, blasint *);
void RELAPACK_dsytrf_rook_rec2(const char *, const int *, const int *, int *, double *, const int *, int *, double *, const int *, int *); void RELAPACK_dsytrf_rook_rec2(const char *, const blasint *, const blasint *, blasint *, double *, const blasint *, blasint *, double *, const blasint *, blasint *);
void RELAPACK_csytrf_rook_rec2(const char *, const int *, const int *, int *, float *, const int *, int *, float *, const int *, int *); void RELAPACK_csytrf_rook_rec2(const char *, const blasint *, const blasint *, blasint *, float *, const blasint *, blasint *, float *, const blasint *, blasint *);
void RELAPACK_chetrf_rook_rec2(const char *, const int *, const int *, int *, float *, const int *, int *, float *, const int *, int *); void RELAPACK_chetrf_rook_rec2(const char *, const blasint *, const blasint *, blasint *, float *, const blasint *, blasint *, float *, const blasint *, blasint *);
void RELAPACK_zsytrf_rook_rec2(const char *, const int *, const int *, int *, double *, const int *, int *, double *, const int *, int *); void RELAPACK_zsytrf_rook_rec2(const char *, const blasint *, const blasint *, blasint *, double *, const blasint *, blasint *, double *, const blasint *, blasint *);
void RELAPACK_zhetrf_rook_rec2(const char *, const int *, const int *, int *, double *, const int *, int *, double *, const int *, int *); void RELAPACK_zhetrf_rook_rec2(const char *, const blasint *, const blasint *, blasint *, double *, const blasint *, blasint *, double *, const blasint *, blasint *);
// trsyl helper routines // trsyl helper routines
void RELAPACK_strsyl_rec2(const char *, const char *, const int *, const int *, const int *, const float *, const int *, const float *, const int *, float *, const int *, float *, int *); void RELAPACK_strsyl_rec2(const char *, const char *, const blasint *, const blasint *, const blasint *, const float *, const blasint *, const float *, const blasint *, float *, const blasint *, float *, blasint *);
void RELAPACK_dtrsyl_rec2(const char *, const char *, const int *, const int *, const int *, const double *, const int *, const double *, const int *, double *, const int *, double *, int *); void RELAPACK_dtrsyl_rec2(const char *, const char *, const blasint *, const blasint *, const blasint *, const double *, const blasint *, const double *, const blasint *, double *, const blasint *, double *, blasint *);
void RELAPACK_ctrsyl_rec2(const char *, const char *, const int *, const int *, const int *, const float *, const int *, const float *, const int *, float *, const int *, float *, int *); void RELAPACK_ctrsyl_rec2(const char *, const char *, const blasint *, const blasint *, const blasint *, const float *, const blasint *, const float *, const blasint *, float *, const blasint *, float *, blasint *);
void RELAPACK_ztrsyl_rec2(const char *, const char *, const int *, const int *, const int *, const double *, const int *, const double *, const int *, double *, const int *, double *, int *); void RELAPACK_ztrsyl_rec2(const char *, const char *, const blasint *, const blasint *, const blasint *, const double *, const blasint *, const double *, const blasint *, double *, const blasint *, double *, blasint *);
#endif /* RELAPACK_INT_H */ #endif /* RELAPACK_INT_H */

79
relapack/src/sgbtrf.c
View File

@ -1,9 +1,9 @@
#include "relapack.h" #include "relapack.h"
#include "stdlib.h" #include "stdlib.h"
static void RELAPACK_sgbtrf_rec(const int *, const int *, const int *, static void RELAPACK_sgbtrf_rec(const blasint *, const blasint *, const blasint *,
const int *, float *, const int *, int *, float *, const int *, float *, const blasint *, float *, const blasint *, blasint *, float *, const blasint *, float *,
const int *, int *); const blasint *, blasint *);
/** SGBTRF computes an LU factorization of a real m-by-n band matrix A using partial pivoting with row interchanges. /** SGBTRF computes an LU factorization of a real m-by-n band matrix A using partial pivoting with row interchanges.
@ -13,11 +13,10 @@ static void RELAPACK_sgbtrf_rec(const int *, const int *, const int *,
* http://www.netlib.org/lapack/explore-html/d5/d72/sgbtrf_8f.html * http://www.netlib.org/lapack/explore-html/d5/d72/sgbtrf_8f.html
* */ * */
void RELAPACK_sgbtrf( void RELAPACK_sgbtrf(
const int *m, const int *n, const int *kl, const int *ku, const blasint *m, const blasint *n, const blasint *kl, const blasint *ku,
float *Ab, const int *ldAb, int *ipiv, float *Ab, const blasint *ldAb, blasint *ipiv,
int *info blasint *info
) { ) {
// Check arguments // Check arguments
*info = 0; *info = 0;
if (*m < 0) if (*m < 0)
@ -31,8 +30,8 @@ void RELAPACK_sgbtrf(
else if (*ldAb < 2 * *kl + *ku + 1) else if (*ldAb < 2 * *kl + *ku + 1)
*info = -6; *info = -6;
if (*info) { if (*info) {
const int minfo = -*info; const blasint minfo = -*info;
LAPACK(xerbla)("SGBTRF", &minfo); LAPACK(xerbla)("SGBTRF", &minfo, strlen("SGBTRF"));
return; return;
} }
@ -40,14 +39,14 @@ void RELAPACK_sgbtrf(
const float ZERO[] = { 0. }; const float ZERO[] = { 0. };
// Result upper band width // Result upper band width
const int kv = *ku + *kl; const blasint kv = *ku + *kl;
// Unskewg A // Unskewg A
const int ldA[] = { *ldAb - 1 }; const blasint ldA[] = { *ldAb - 1 };
float *const A = Ab + kv; float *const A = Ab + kv;
// Zero upper diagonal fill-in elements // Zero upper diagonal fill-in elements
int i, j; blasint i, j;
for (j = 0; j < *n; j++) { for (j = 0; j < *n; j++) {
float *const A_j = A + *ldA * j; float *const A_j = A + *ldA * j;
for (i = MAX(0, j - kv); i < j - *ku; i++) for (i = MAX(0, j - kv); i < j - *ku; i++)
@ -55,11 +54,11 @@ void RELAPACK_sgbtrf(
} }
// Allocate work space // Allocate work space
const int n1 = SREC_SPLIT(*n); const blasint n1 = SREC_SPLIT(*n);
const int mWorkl = (kv > n1) ? MAX(1, *m - *kl) : kv; const blasint mWorkl = (kv > n1) ? MAX(1, *m - *kl) : kv;
const int nWorkl = (kv > n1) ? n1 : kv; const blasint nWorkl = (kv > n1) ? n1 : kv;
const int mWorku = (*kl > n1) ? n1 : *kl; const blasint mWorku = (*kl > n1) ? n1 : *kl;
const int nWorku = (*kl > n1) ? MAX(0, *n - *kl) : *kl; const blasint nWorku = (*kl > n1) ? MAX(0, *n - *kl) : *kl;
float *Workl = malloc(mWorkl * nWorkl * sizeof(float)); float *Workl = malloc(mWorkl * nWorkl * sizeof(float));
float *Worku = malloc(mWorku * nWorku * sizeof(float)); float *Worku = malloc(mWorku * nWorku * sizeof(float));
LAPACK(slaset)("L", &mWorkl, &nWorkl, ZERO, ZERO, Workl, &mWorkl); LAPACK(slaset)("L", &mWorkl, &nWorkl, ZERO, ZERO, Workl, &mWorkl);
@ -76,10 +75,10 @@ void RELAPACK_sgbtrf(
/** sgbtrf's recursive compute kernel */ /** sgbtrf's recursive compute kernel */
static void RELAPACK_sgbtrf_rec( static void RELAPACK_sgbtrf_rec(
const int *m, const int *n, const int *kl, const int *ku, const blasint *m, const blasint *n, const blasint *kl, const blasint *ku,
float *Ab, const int *ldAb, int *ipiv, float *Ab, const blasint *ldAb, blasint *ipiv,
float *Workl, const int *ldWorkl, float *Worku, const int *ldWorku, float *Workl, const blasint *ldWorkl, float *Worku, const blasint *ldWorku,
int *info blasint *info
) { ) {
if (*n <= MAX(CROSSOVER_SGBTRF, 1)) { if (*n <= MAX(CROSSOVER_SGBTRF, 1)) {
@ -91,25 +90,25 @@ static void RELAPACK_sgbtrf_rec(
// Constants // Constants
const float ONE[] = { 1. }; const float ONE[] = { 1. };
const float MONE[] = { -1. }; const float MONE[] = { -1. };
const int iONE[] = { 1 }; const blasint iONE[] = { 1 };
// Loop iterators // Loop iterators
int i, j; blasint i, j;
// Output upper band width // Output upper band width
const int kv = *ku + *kl; const blasint kv = *ku + *kl;
// Unskew A // Unskew A
const int ldA[] = { *ldAb - 1 }; const blasint ldA[] = { *ldAb - 1 };
float *const A = Ab + kv; float *const A = Ab + kv;
// Splitting // Splitting
const int n1 = MIN(SREC_SPLIT(*n), *kl); const blasint n1 = MIN(SREC_SPLIT(*n), *kl);
const int n2 = *n - n1; const blasint n2 = *n - n1;
const int m1 = MIN(n1, *m); const blasint m1 = MIN(n1, *m);
const int m2 = *m - m1; const blasint m2 = *m - m1;
const int mn1 = MIN(m1, n1); const blasint mn1 = MIN(m1, n1);
const int mn2 = MIN(m2, n2); const blasint mn2 = MIN(m2, n2);
// Ab_L * // Ab_L *
// Ab_BR // Ab_BR
@ -129,14 +128,14 @@ static void RELAPACK_sgbtrf_rec(
// ipiv_T // ipiv_T
// ipiv_B // ipiv_B
int *const ipiv_T = ipiv; blasint *const ipiv_T = ipiv;
int *const ipiv_B = ipiv + n1; blasint *const ipiv_B = ipiv + n1;
// Banded splitting // Banded splitting
const int n21 = MIN(n2, kv - n1); const blasint n21 = MIN(n2, kv - n1);
const int n22 = MIN(n2 - n21, n1); const blasint n22 = MIN(n2 - n21, n1);
const int m21 = MIN(m2, *kl - m1); const blasint m21 = MIN(m2, *kl - m1);
const int m22 = MIN(m2 - m21, m1); const blasint m22 = MIN(m2 - m21, m1);
// n1 n21 n22 // n1 n21 n22
// m * A_Rl ARr // m * A_Rl ARr
@ -164,7 +163,7 @@ static void RELAPACK_sgbtrf_rec(
// partially redo swaps in A_L // partially redo swaps in A_L
for (i = 0; i < mn1; i++) { for (i = 0; i < mn1; i++) {
const int ip = ipiv_T[i] - 1; const blasint ip = ipiv_T[i] - 1;
if (ip != i) { if (ip != i) {
if (ip < *kl) if (ip < *kl)
BLAS(sswap)(&i, A_L + i, ldA, A_L + ip, ldA); BLAS(sswap)(&i, A_L + i, ldA, A_L + ip, ldA);
@ -180,7 +179,7 @@ static void RELAPACK_sgbtrf_rec(
for (j = 0; j < n22; j++) { for (j = 0; j < n22; j++) {
float *const A_Rrj = A_Rr + *ldA * j; float *const A_Rrj = A_Rr + *ldA * j;
for (i = j; i < mn1; i++) { for (i = j; i < mn1; i++) {
const int ip = ipiv_T[i] - 1; const blasint ip = ipiv_T[i] - 1;
if (ip != i) { if (ip != i) {
const float tmp = A_Rrj[i]; const float tmp = A_Rrj[i];
A_Rrj[i] = A_Rr[ip]; A_Rrj[i] = A_Rr[ip];
@ -208,7 +207,7 @@ static void RELAPACK_sgbtrf_rec(
// partially undo swaps in A_L // partially undo swaps in A_L
for (i = mn1 - 1; i >= 0; i--) { for (i = mn1 - 1; i >= 0; i--) {
const int ip = ipiv_T[i] - 1; const blasint ip = ipiv_T[i] - 1;
if (ip != i) { if (ip != i) {
if (ip < *kl) if (ip < *kl)
BLAS(sswap)(&i, A_L + i, ldA, A_L + ip, ldA); BLAS(sswap)(&i, A_L + i, ldA, A_L + ip, ldA);

62
relapack/src/sgemmt.c
View File

@ -1,12 +1,12 @@
#include "relapack.h" #include "relapack.h"
static void RELAPACK_sgemmt_rec(const char *, const char *, const char *, static void RELAPACK_sgemmt_rec(const char *, const char *, const char *,
const int *, const int *, const float *, const float *, const int *, const blasint *, const blasint *, const float *, const float *, const blasint *,
const float *, const int *, const float *, float *, const int *); const float *, const blasint *, const float *, float *, const blasint *);
static void RELAPACK_sgemmt_rec2(const char *, const char *, const char *, static void RELAPACK_sgemmt_rec2(const char *, const char *, const char *,
const int *, const int *, const float *, const float *, const int *, const blasint *, const blasint *, const float *, const float *, const blasint *,
const float *, const int *, const float *, float *, const int *); const float *, const blasint *, const float *, float *, const blasint *);
/** SGEMMT computes a matrix-matrix product with general matrices but updates /** SGEMMT computes a matrix-matrix product with general matrices but updates
@ -20,10 +20,10 @@ static void RELAPACK_sgemmt_rec2(const char *, const char *, const char *,
* */ * */
void RELAPACK_sgemmt( void RELAPACK_sgemmt(
const char *uplo, const char *transA, const char *transB, const char *uplo, const char *transA, const char *transB,
const int *n, const int *k, const blasint *n, const blasint *k,
const float *alpha, const float *A, const int *ldA, const float *alpha, const float *A, const blasint *ldA,
const float *B, const int *ldB, const float *B, const blasint *ldB,
const float *beta, float *C, const int *ldC const float *beta, float *C, const blasint *ldC
) { ) {
#if HAVE_XGEMMT #if HAVE_XGEMMT
@ -32,13 +32,13 @@ void RELAPACK_sgemmt(
#else #else
// Check arguments // Check arguments
const int lower = LAPACK(lsame)(uplo, "L"); const blasint lower = LAPACK(lsame)(uplo, "L");
const int upper = LAPACK(lsame)(uplo, "U"); const blasint upper = LAPACK(lsame)(uplo, "U");
const int notransA = LAPACK(lsame)(transA, "N"); const blasint notransA = LAPACK(lsame)(transA, "N");
const int tranA = LAPACK(lsame)(transA, "T"); const blasint tranA = LAPACK(lsame)(transA, "T");
const int notransB = LAPACK(lsame)(transB, "N"); const blasint notransB = LAPACK(lsame)(transB, "N");
const int tranB = LAPACK(lsame)(transB, "T"); const blasint tranB = LAPACK(lsame)(transB, "T");
int info = 0; blasint info = 0;
if (!lower && !upper) if (!lower && !upper)
info = 1; info = 1;
else if (!tranA && !notransA) else if (!tranA && !notransA)
@ -56,7 +56,7 @@ void RELAPACK_sgemmt(
else if (*ldC < MAX(1, *n)) else if (*ldC < MAX(1, *n))
info = 13; info = 13;
if (info) { if (info) {
LAPACK(xerbla)("SGEMMT", &info); LAPACK(xerbla)("SGEMMT", &info, strlen("SGEMMT"));
return; return;
} }
@ -74,10 +74,10 @@ void RELAPACK_sgemmt(
/** sgemmt's recursive compute kernel */ /** sgemmt's recursive compute kernel */
static void RELAPACK_sgemmt_rec( static void RELAPACK_sgemmt_rec(
const char *uplo, const char *transA, const char *transB, const char *uplo, const char *transA, const char *transB,
const int *n, const int *k, const blasint *n, const blasint *k,
const float *alpha, const float *A, const int *ldA, const float *alpha, const float *A, const blasint *ldA,
const float *B, const int *ldB, const float *B, const blasint *ldB,
const float *beta, float *C, const int *ldC const float *beta, float *C, const blasint *ldC
) { ) {
if (*n <= MAX(CROSSOVER_SGEMMT, 1)) { if (*n <= MAX(CROSSOVER_SGEMMT, 1)) {
@ -87,8 +87,8 @@ static void RELAPACK_sgemmt_rec(
} }
// Splitting // Splitting
const int n1 = SREC_SPLIT(*n); const blasint n1 = SREC_SPLIT(*n);
const int n2 = *n - n1; const blasint n2 = *n - n1;
// A_T // A_T
// A_B // A_B
@ -124,16 +124,16 @@ static void RELAPACK_sgemmt_rec(
/** sgemmt's unblocked compute kernel */ /** sgemmt's unblocked compute kernel */
static void RELAPACK_sgemmt_rec2( static void RELAPACK_sgemmt_rec2(
const char *uplo, const char *transA, const char *transB, const char *uplo, const char *transA, const char *transB,
const int *n, const int *k, const blasint *n, const blasint *k,
const float *alpha, const float *A, const int *ldA, const float *alpha, const float *A, const blasint *ldA,
const float *B, const int *ldB, const float *B, const blasint *ldB,
const float *beta, float *C, const int *ldC const float *beta, float *C, const blasint *ldC
) { ) {
const int incB = (*transB == 'N') ? 1 : *ldB; const blasint incB = (*transB == 'N') ? 1 : *ldB;
const int incC = 1; const blasint incC = 1;
int i; blasint i;
for (i = 0; i < *n; i++) { for (i = 0; i < *n; i++) {
// A_0 // A_0
// A_i // A_i
@ -149,13 +149,13 @@ static void RELAPACK_sgemmt_rec2(
float *const C_ii = C + *ldC * i + i; float *const C_ii = C + *ldC * i + i;
if (*uplo == 'L') { if (*uplo == 'L') {
const int nmi = *n - i; const blasint nmi = *n - i;
if (*transA == 'N') if (*transA == 'N')
BLAS(sgemv)(transA, &nmi, k, alpha, A_i, ldA, B_i, &incB, beta, C_ii, &incC); BLAS(sgemv)(transA, &nmi, k, alpha, A_i, ldA, B_i, &incB, beta, C_ii, &incC);
else else
BLAS(sgemv)(transA, k, &nmi, alpha, A_i, ldA, B_i, &incB, beta, C_ii, &incC); BLAS(sgemv)(transA, k, &nmi, alpha, A_i, ldA, B_i, &incB, beta, C_ii, &incC);
} else { } else {
const int ip1 = i + 1; const blasint ip1 = i + 1;
if (*transA == 'N') if (*transA == 'N')
BLAS(sgemv)(transA, &ip1, k, alpha, A_0, ldA, B_i, &incB, beta, C_0i, &incC); BLAS(sgemv)(transA, &ip1, k, alpha, A_0, ldA, B_i, &incB, beta, C_0i, &incC);
else else

40
relapack/src/sgetrf.c
View File

@ -1,7 +1,7 @@
#include "relapack.h" #include "relapack.h"
static void RELAPACK_sgetrf_rec(const int *, const int *, float *, const int *, static void RELAPACK_sgetrf_rec(const blasint *, const blasint *, float *, const blasint *,
int *, int *); blasint *, blasint *);
/** SGETRF computes an LU factorization of a general M-by-N matrix A using partial pivoting with row interchanges. /** SGETRF computes an LU factorization of a general M-by-N matrix A using partial pivoting with row interchanges.
@ -11,9 +11,9 @@ static void RELAPACK_sgetrf_rec(const int *, const int *, float *, const int *,
* http://www.netlib.org/lapack/explore-html/de/de2/sgetrf_8f.html * http://www.netlib.org/lapack/explore-html/de/de2/sgetrf_8f.html
* */ * */
void RELAPACK_sgetrf( void RELAPACK_sgetrf(
const int *m, const int *n, const blasint *m, const blasint *n,
float *A, const int *ldA, int *ipiv, float *A, const blasint *ldA, blasint *ipiv,
int *info blasint *info
) { ) {
// Check arguments // Check arguments
@ -25,12 +25,12 @@ void RELAPACK_sgetrf(
else if (*ldA < MAX(1, *n)) else if (*ldA < MAX(1, *n))
*info = -4; *info = -4;
if (*info) { if (*info) {
const int minfo = -*info; const blasint minfo = -*info;
LAPACK(xerbla)("SGETRF", &minfo); LAPACK(xerbla)("SGETRF", &minfo, strlen("SGETRF"));
return; return;
} }
const int sn = MIN(*m, *n); const blasint sn = MIN(*m, *n);
RELAPACK_sgetrf_rec(m, &sn, A, ldA, ipiv, info); RELAPACK_sgetrf_rec(m, &sn, A, ldA, ipiv, info);
@ -38,10 +38,10 @@ void RELAPACK_sgetrf(
if (*m < *n) { if (*m < *n) {
// Constants // Constants
const float ONE[] = { 1. }; const float ONE[] = { 1. };
const int iONE[] = { 1. }; const blasint iONE[] = { 1. };
// Splitting // Splitting
const int rn = *n - *m; const blasint rn = *n - *m;
// A_L A_R // A_L A_R
const float *const A_L = A; const float *const A_L = A;
@ -57,9 +57,9 @@ void RELAPACK_sgetrf(
/** sgetrf's recursive compute kernel */ /** sgetrf's recursive compute kernel */
static void RELAPACK_sgetrf_rec( static void RELAPACK_sgetrf_rec(
const int *m, const int *n, const blasint *m, const blasint *n,
float *A, const int *ldA, int *ipiv, float *A, const blasint *ldA, blasint *ipiv,
int *info blasint *info
) { ) {
if (*n <= MAX(CROSSOVER_SGETRF, 1)) { if (*n <= MAX(CROSSOVER_SGETRF, 1)) {
@ -71,12 +71,12 @@ static void RELAPACK_sgetrf_rec(
// Constants // Constants
const float ONE[] = { 1. }; const float ONE[] = { 1. };
const float MONE[] = { -1. }; const float MONE[] = { -1. };
const int iONE[] = { 1 }; const blasint iONE[] = { 1 };
// Splitting // Splitting
const int n1 = SREC_SPLIT(*n); const blasint n1 = SREC_SPLIT(*n);
const int n2 = *n - n1; const blasint n2 = *n - n1;
const int m2 = *m - n1; const blasint m2 = *m - n1;
// A_L A_R // A_L A_R
float *const A_L = A; float *const A_L = A;
@ -91,8 +91,8 @@ static void RELAPACK_sgetrf_rec(
// ipiv_T // ipiv_T
// ipiv_B // ipiv_B
int *const ipiv_T = ipiv; blasint *const ipiv_T = ipiv;
int *const ipiv_B = ipiv + n1; blasint *const ipiv_B = ipiv + n1;
// recursion(A_L, ipiv_T) // recursion(A_L, ipiv_T)
RELAPACK_sgetrf_rec(m, &n1, A_L, ldA, ipiv_T, info); RELAPACK_sgetrf_rec(m, &n1, A_L, ldA, ipiv_T, info);
@ -111,7 +111,7 @@ static void RELAPACK_sgetrf_rec(
// apply pivots to A_BL // apply pivots to A_BL
LAPACK(slaswp)(&n1, A_BL, ldA, iONE, &n2, ipiv_B, iONE); LAPACK(slaswp)(&n1, A_BL, ldA, iONE, &n2, ipiv_B, iONE);
// shift pivots // shift pivots
int i; blasint i;
for (i = 0; i < n2; i++) for (i = 0; i < n2; i++)
ipiv_B[i] += n1; ipiv_B[i] += n1;
} }

28
relapack/src/slauum.c
View File

@ -1,7 +1,7 @@
#include "relapack.h" #include "relapack.h"
static void RELAPACK_slauum_rec(const char *, const int *, float *, static void RELAPACK_slauum_rec(const char *, const blasint *, float *,
const int *, int *); const blasint *, blasint *);
/** SLAUUM computes the product U * U**T or L**T * L, where the triangular factor U or L is stored in the upper or lower triangular part of the array A. /** SLAUUM computes the product U * U**T or L**T * L, where the triangular factor U or L is stored in the upper or lower triangular part of the array A.
@ -11,14 +11,14 @@ static void RELAPACK_slauum_rec(const char *, const int *, float *,
* http://www.netlib.org/lapack/explore-html/dd/d5a/slauum_8f.html * http://www.netlib.org/lapack/explore-html/dd/d5a/slauum_8f.html
* */ * */
void RELAPACK_slauum( void RELAPACK_slauum(
const char *uplo, const int *n, const char *uplo, const blasint *n,
float *A, const int *ldA, float *A, const blasint *ldA,
int *info blasint *info
) { ) {
// Check arguments // Check arguments
const int lower = LAPACK(lsame)(uplo, "L"); const blasint lower = LAPACK(lsame)(uplo, "L");
const int upper = LAPACK(lsame)(uplo, "U"); const blasint upper = LAPACK(lsame)(uplo, "U");
*info = 0; *info = 0;
if (!lower && !upper) if (!lower && !upper)
*info = -1; *info = -1;
@ -27,8 +27,8 @@ void RELAPACK_slauum(
else if (*ldA < MAX(1, *n)) else if (*ldA < MAX(1, *n))
*info = -4; *info = -4;
if (*info) { if (*info) {
const int minfo = -*info; const blasint minfo = -*info;
LAPACK(xerbla)("SLAUUM", &minfo); LAPACK(xerbla)("SLAUUM", &minfo, strlen("SLAUUM"));
return; return;
} }
@ -42,9 +42,9 @@ void RELAPACK_slauum(
/** slauum's recursive compute kernel */ /** slauum's recursive compute kernel */
static void RELAPACK_slauum_rec( static void RELAPACK_slauum_rec(
const char *uplo, const int *n, const char *uplo, const blasint *n,
float *A, const int *ldA, float *A, const blasint *ldA,
int *info blasint *info
) { ) {
if (*n <= MAX(CROSSOVER_SLAUUM, 1)) { if (*n <= MAX(CROSSOVER_SLAUUM, 1)) {
@ -57,8 +57,8 @@ static void RELAPACK_slauum_rec(
const float ONE[] = { 1. }; const float ONE[] = { 1. };
// Splitting // Splitting
const int n1 = SREC_SPLIT(*n); const blasint n1 = SREC_SPLIT(*n);
const int n2 = *n - n1; const blasint n2 = *n - n1;
// A_TL A_TR // A_TL A_TR
// A_BL A_BR // A_BL A_BR

42
relapack/src/spbtrf.c
View File

@ -1,8 +1,8 @@
#include "relapack.h" #include "relapack.h"
#include "stdlib.h" #include "stdlib.h"
static void RELAPACK_spbtrf_rec(const char *, const int *, const int *, static void RELAPACK_spbtrf_rec(const char *, const blasint *, const blasint *,
float *, const int *, float *, const int *, int *); float *, const blasint *, float *, const blasint *, blasint *);
/** SPBTRF computes the Cholesky factorization of a real symmetric positive definite band matrix A. /** SPBTRF computes the Cholesky factorization of a real symmetric positive definite band matrix A.
@ -12,14 +12,14 @@ static void RELAPACK_spbtrf_rec(const char *, const int *, const int *,
* http://www.netlib.org/lapack/explore-html/d1/d22/spbtrf_8f.html * http://www.netlib.org/lapack/explore-html/d1/d22/spbtrf_8f.html
* */ * */
void RELAPACK_spbtrf( void RELAPACK_spbtrf(
const char *uplo, const int *n, const int *kd, const char *uplo, const blasint *n, const blasint *kd,
float *Ab, const int *ldAb, float *Ab, const blasint *ldAb,
int *info blasint *info
) { ) {
// Check arguments // Check arguments
const int lower = LAPACK(lsame)(uplo, "L"); const blasint lower = LAPACK(lsame)(uplo, "L");
const int upper = LAPACK(lsame)(uplo, "U"); const blasint upper = LAPACK(lsame)(uplo, "U");
*info = 0; *info = 0;
if (!lower && !upper) if (!lower && !upper)
*info = -1; *info = -1;
@ -30,8 +30,8 @@ void RELAPACK_spbtrf(
else if (*ldAb < *kd + 1) else if (*ldAb < *kd + 1)
*info = -5; *info = -5;
if (*info) { if (*info) {
const int minfo = -*info; const blasint minfo = -*info;
LAPACK(xerbla)("SPBTRF", &minfo); LAPACK(xerbla)("SPBTRF", &minfo, strlen("SPBTRF"));
return; return;
} }
@ -42,9 +42,9 @@ void RELAPACK_spbtrf(
const float ZERO[] = { 0. }; const float ZERO[] = { 0. };
// Allocate work space // Allocate work space
const int n1 = SREC_SPLIT(*n); const blasint n1 = SREC_SPLIT(*n);
const int mWork = (*kd > n1) ? (lower ? *n - *kd : n1) : *kd; const blasint mWork = (*kd > n1) ? (lower ? *n - *kd : n1) : *kd;
const int nWork = (*kd > n1) ? (lower ? n1 : *n - *kd) : *kd; const blasint nWork = (*kd > n1) ? (lower ? n1 : *n - *kd) : *kd;
float *Work = malloc(mWork * nWork * sizeof(float)); float *Work = malloc(mWork * nWork * sizeof(float));
LAPACK(slaset)(uplo, &mWork, &nWork, ZERO, ZERO, Work, &mWork); LAPACK(slaset)(uplo, &mWork, &nWork, ZERO, ZERO, Work, &mWork);
@ -58,10 +58,10 @@ void RELAPACK_spbtrf(
/** spbtrf's recursive compute kernel */ /** spbtrf's recursive compute kernel */
static void RELAPACK_spbtrf_rec( static void RELAPACK_spbtrf_rec(
const char *uplo, const int *n, const int *kd, const char *uplo, const blasint *n, const blasint *kd,
float *Ab, const int *ldAb, float *Ab, const blasint *ldAb,
float *Work, const int *ldWork, float *Work, const blasint *ldWork,
int *info blasint *info
){ ){
if (*n <= MAX(CROSSOVER_SPBTRF, 1)) { if (*n <= MAX(CROSSOVER_SPBTRF, 1)) {
@ -75,12 +75,12 @@ static void RELAPACK_spbtrf_rec(
const float MONE[] = { -1. }; const float MONE[] = { -1. };
// Unskew A // Unskew A
const int ldA[] = { *ldAb - 1 }; const blasint ldA[] = { *ldAb - 1 };
float *const A = Ab + ((*uplo == 'L') ? 0 : *kd); float *const A = Ab + ((*uplo == 'L') ? 0 : *kd);
// Splitting // Splitting
const int n1 = MIN(SREC_SPLIT(*n), *kd); const blasint n1 = MIN(SREC_SPLIT(*n), *kd);
const int n2 = *n - n1; const blasint n2 = *n - n1;
// * * // * *
// * Ab_BR // * Ab_BR
@ -99,8 +99,8 @@ static void RELAPACK_spbtrf_rec(
return; return;
// Banded splitting // Banded splitting
const int n21 = MIN(n2, *kd - n1); const blasint n21 = MIN(n2, *kd - n1);
const int n22 = MIN(n2 - n21, *kd); const blasint n22 = MIN(n2 - n21, *kd);
// n1 n21 n22 // n1 n21 n22
// n1 * A_TRl A_TRr // n1 * A_TRl A_TRr

28
relapack/src/spotrf.c
View File

@ -1,7 +1,7 @@
#include "relapack.h" #include "relapack.h"
static void RELAPACK_spotrf_rec(const char *, const int *, float *, static void RELAPACK_spotrf_rec(const char *, const blasint *, float *,
const int *, int *); const blasint *, blasint *);
/** SPOTRF computes the Cholesky factorization of a real symmetric positive definite matrix A. /** SPOTRF computes the Cholesky factorization of a real symmetric positive definite matrix A.
@ -11,14 +11,14 @@ static void RELAPACK_spotrf_rec(const char *, const int *, float *,
* http://www.netlib.org/lapack/explore-html/d0/da2/spotrf_8f.html * http://www.netlib.org/lapack/explore-html/d0/da2/spotrf_8f.html
* */ * */
void RELAPACK_spotrf( void RELAPACK_spotrf(
const char *uplo, const int *n, const char *uplo, const blasint *n,
float *A, const int *ldA, float *A, const blasint *ldA,
int *info blasint *info
) { ) {
// Check arguments // Check arguments
const int lower = LAPACK(lsame)(uplo, "L"); const blasint lower = LAPACK(lsame)(uplo, "L");
const int upper = LAPACK(lsame)(uplo, "U"); const blasint upper = LAPACK(lsame)(uplo, "U");
*info = 0; *info = 0;
if (!lower && !upper) if (!lower && !upper)
*info = -1; *info = -1;
@ -27,8 +27,8 @@ void RELAPACK_spotrf(
else if (*ldA < MAX(1, *n)) else if (*ldA < MAX(1, *n))
*info = -4; *info = -4;
if (*info) { if (*info) {
const int minfo = -*info; const blasint minfo = -*info;
LAPACK(xerbla)("SPOTRF", &minfo); LAPACK(xerbla)("SPOTRF", &minfo, strlen("SPOTRF"));
return; return;
} }
@ -42,9 +42,9 @@ void RELAPACK_spotrf(
/** spotrf's recursive compute kernel */ /** spotrf's recursive compute kernel */
static void RELAPACK_spotrf_rec( static void RELAPACK_spotrf_rec(
const char *uplo, const int *n, const char *uplo, const blasint *n,
float *A, const int *ldA, float *A, const blasint *ldA,
int *info blasint *info
) { ) {
if (*n <= MAX(CROSSOVER_SPOTRF, 1)) { if (*n <= MAX(CROSSOVER_SPOTRF, 1)) {
@ -58,8 +58,8 @@ static void RELAPACK_spotrf_rec(
const float MONE[] = { -1. }; const float MONE[] = { -1. };
// Splitting // Splitting
const int n1 = SREC_SPLIT(*n); const blasint n1 = SREC_SPLIT(*n);
const int n2 = *n - n1; const blasint n2 = *n - n1;
// A_TL A_TR // A_TL A_TR
// A_BL A_BR // A_BL A_BR

38
relapack/src/ssygst.c
View File

@ -3,9 +3,9 @@
#include "stdlib.h" #include "stdlib.h"
#endif #endif
static void RELAPACK_ssygst_rec(const int *, const char *, const int *, static void RELAPACK_ssygst_rec(const blasint *, const char *, const blasint *,
float *, const int *, const float *, const int *, float *, const blasint *, const float *, const blasint *,
float *, const int *, int *); float *, const blasint *, blasint *);
/** SSYGST reduces a real symmetric-definite generalized eigenproblem to standard form. /** SSYGST reduces a real symmetric-definite generalized eigenproblem to standard form.
@ -15,14 +15,14 @@ static void RELAPACK_ssygst_rec(const int *, const char *, const int *,
* http://www.netlib.org/lapack/explore-html/d8/d78/ssygst_8f.html * http://www.netlib.org/lapack/explore-html/d8/d78/ssygst_8f.html
* */ * */
void RELAPACK_ssygst( void RELAPACK_ssygst(
const int *itype, const char *uplo, const int *n, const blasint *itype, const char *uplo, const blasint *n,
float *A, const int *ldA, const float *B, const int *ldB, float *A, const blasint *ldA, const float *B, const blasint *ldB,
int *info blasint *info
) { ) {
// Check arguments // Check arguments
const int lower = LAPACK(lsame)(uplo, "L"); const blasint lower = LAPACK(lsame)(uplo, "L");
const int upper = LAPACK(lsame)(uplo, "U"); const blasint upper = LAPACK(lsame)(uplo, "U");
*info = 0; *info = 0;
if (*itype < 1 || *itype > 3) if (*itype < 1 || *itype > 3)
*info = -1; *info = -1;
@ -35,8 +35,8 @@ void RELAPACK_ssygst(
else if (*ldB < MAX(1, *n)) else if (*ldB < MAX(1, *n))
*info = -7; *info = -7;
if (*info) { if (*info) {
const int minfo = -*info; const blasint minfo = -*info;
LAPACK(xerbla)("SSYGST", &minfo); LAPACK(xerbla)("SSYGST", &minfo, strlen("SSYGST"));
return; return;
} }
@ -45,9 +45,9 @@ void RELAPACK_ssygst(
// Allocate work space // Allocate work space
float *Work = NULL; float *Work = NULL;
int lWork = 0; blasint lWork = 0;
#if XSYGST_ALLOW_MALLOC #if XSYGST_ALLOW_MALLOC
const int n1 = SREC_SPLIT(*n); const blasint n1 = SREC_SPLIT(*n);
lWork = n1 * (*n - n1); lWork = n1 * (*n - n1);
Work = malloc(lWork * sizeof(float)); Work = malloc(lWork * sizeof(float));
if (!Work) if (!Work)
@ -67,9 +67,9 @@ void RELAPACK_ssygst(
/** ssygst's recursive compute kernel */ /** ssygst's recursive compute kernel */
static void RELAPACK_ssygst_rec( static void RELAPACK_ssygst_rec(
const int *itype, const char *uplo, const int *n, const blasint *itype, const char *uplo, const blasint *n,
float *A, const int *ldA, const float *B, const int *ldB, float *A, const blasint *ldA, const float *B, const blasint *ldB,
float *Work, const int *lWork, int *info float *Work, const blasint *lWork, blasint *info
) { ) {
if (*n <= MAX(CROSSOVER_SSYGST, 1)) { if (*n <= MAX(CROSSOVER_SSYGST, 1)) {
@ -84,14 +84,14 @@ static void RELAPACK_ssygst_rec(
const float MONE[] = { -1. }; const float MONE[] = { -1. };
const float HALF[] = { .5 }; const float HALF[] = { .5 };
const float MHALF[] = { -.5 }; const float MHALF[] = { -.5 };
const int iONE[] = { 1 }; const blasint iONE[] = { 1 };
// Loop iterator // Loop iterator
int i; blasint i;
// Splitting // Splitting
const int n1 = SREC_SPLIT(*n); const blasint n1 = SREC_SPLIT(*n);
const int n2 = *n - n1; const blasint n2 = *n - n1;
// A_TL A_TR // A_TL A_TR
// A_BL A_BR // A_BL A_BR

73
relapack/src/ssytrf.c
View File

@ -2,9 +2,8 @@
#if XSYTRF_ALLOW_MALLOC #if XSYTRF_ALLOW_MALLOC
#include <stdlib.h> #include <stdlib.h>
#endif #endif
static void RELAPACK_ssytrf_rec(const char *, const blasint *, const blasint *, blasint *,
static void RELAPACK_ssytrf_rec(const char *, const int *, const int *, int *, float *, const blasint *, blasint *, float *, const blasint *, blasint *);
float *, const int *, int *, float *, const int *, int *);
/** SSYTRF computes the factorization of a complex symmetric matrix A using the Bunch-Kaufman diagonal pivoting method. /** SSYTRF computes the factorization of a complex symmetric matrix A using the Bunch-Kaufman diagonal pivoting method.
@ -14,21 +13,21 @@ static void RELAPACK_ssytrf_rec(const char *, const int *, const int *, int *,
* http://www.netlib.org/lapack/explore-html/da/de9/ssytrf_8f.html * http://www.netlib.org/lapack/explore-html/da/de9/ssytrf_8f.html
* */ * */
void RELAPACK_ssytrf( void RELAPACK_ssytrf(
const char *uplo, const int *n, const char *uplo, const blasint *n,
float *A, const int *ldA, int *ipiv, float *A, const blasint *ldA, blasint *ipiv,
float *Work, const int *lWork, int *info float *Work, const blasint *lWork, blasint *info
) { ) {
// Required work size // Required work size
const int cleanlWork = *n * (*n / 2); const blasint cleanlWork = *n * (*n / 2);
int minlWork = cleanlWork; blasint minlWork = cleanlWork;
#if XSYTRF_ALLOW_MALLOC #if XSYTRF_ALLOW_MALLOC
minlWork = 1; minlWork = 1;
#endif #endif
// Check arguments // Check arguments
const int lower = LAPACK(lsame)(uplo, "L"); const blasint lower = LAPACK(lsame)(uplo, "L");
const int upper = LAPACK(lsame)(uplo, "U"); const blasint upper = LAPACK(lsame)(uplo, "U");
*info = 0; *info = 0;
if (!lower && !upper) if (!lower && !upper)
*info = -1; *info = -1;
@ -55,8 +54,8 @@ void RELAPACK_ssytrf(
#endif #endif
if (*info) { if (*info) {
const int minfo = -*info; const blasint minfo = -*info;
LAPACK(xerbla)("SSYTRF", &minfo); LAPACK(xerbla)("SSYTRF", &minfo, strlen("SSYTRF"));
return; return;
} }
@ -64,7 +63,7 @@ void RELAPACK_ssytrf(
const char cleanuplo = lower ? 'L' : 'U'; const char cleanuplo = lower ? 'L' : 'U';
// Dummy arguments // Dummy arguments
int nout; blasint nout;
// Recursive kernel // Recursive kernel
RELAPACK_ssytrf_rec(&cleanuplo, n, n, &nout, A, ldA, ipiv, cleanWork, n, info); RELAPACK_ssytrf_rec(&cleanuplo, n, n, &nout, A, ldA, ipiv, cleanWork, n, info);
@ -78,13 +77,13 @@ void RELAPACK_ssytrf(
/** ssytrf's recursive compute kernel */ /** ssytrf's recursive compute kernel */
static void RELAPACK_ssytrf_rec( static void RELAPACK_ssytrf_rec(
const char *uplo, const int *n_full, const int *n, int *n_out, const char *uplo, const blasint *n_full, const blasint *n, blasint *n_out,
float *A, const int *ldA, int *ipiv, float *A, const blasint *ldA, blasint *ipiv,
float *Work, const int *ldWork, int *info float *Work, const blasint *ldWork, blasint *info
) { ) {
// top recursion level? // top recursion level?
const int top = *n_full == *n; const blasint top = *n_full == *n;
if (*n <= MAX(CROSSOVER_SSYTRF, 3)) { if (*n <= MAX(CROSSOVER_SSYTRF, 3)) {
// Unblocked // Unblocked
@ -96,34 +95,34 @@ static void RELAPACK_ssytrf_rec(
return; return;
} }
int info1, info2; blasint info1, info2;
// Constants // Constants
const float ONE[] = { 1. }; const float ONE[] = { 1. };
const float MONE[] = { -1. }; const float MONE[] = { -1. };
const int iONE[] = { 1 }; const blasint iONE[] = { 1 };
// Loop iterator // Loop iterator
int i; blasint i;
const int n_rest = *n_full - *n; const blasint n_rest = *n_full - *n;
if (*uplo == 'L') { if (*uplo == 'L') {
// Splitting (setup) // Splitting (setup)
int n1 = SREC_SPLIT(*n); blasint n1 = SREC_SPLIT(*n);
int n2 = *n - n1; blasint n2 = *n - n1;
// Work_L * // Work_L *
float *const Work_L = Work; float *const Work_L = Work;
// recursion(A_L) // recursion(A_L)
int n1_out; blasint n1_out;
RELAPACK_ssytrf_rec(uplo, n_full, &n1, &n1_out, A, ldA, ipiv, Work_L, ldWork, &info1); RELAPACK_ssytrf_rec(uplo, n_full, &n1, &n1_out, A, ldA, ipiv, Work_L, ldWork, &info1);
n1 = n1_out; n1 = n1_out;
// Splitting (continued) // Splitting (continued)
n2 = *n - n1; n2 = *n - n1;
const int n_full2 = *n_full - n1; const blasint n_full2 = *n_full - n1;
// * * // * *
// A_BL A_BR // A_BL A_BR
@ -139,23 +138,23 @@ static void RELAPACK_ssytrf_rec(
// (top recursion level: use Work as Work_BR) // (top recursion level: use Work as Work_BR)
float *const Work_BL = Work + n1; float *const Work_BL = Work + n1;
float *const Work_BR = top ? Work : Work + *ldWork * n1 + n1; float *const Work_BR = top ? Work : Work + *ldWork * n1 + n1;
const int ldWork_BR = top ? n2 : *ldWork; const blasint ldWork_BR = top ? n2 : *ldWork;
// ipiv_T // ipiv_T
// ipiv_B // ipiv_B
int *const ipiv_B = ipiv + n1; blasint *const ipiv_B = ipiv + n1;
// A_BR = A_BR - A_BL Work_BL' // A_BR = A_BR - A_BL Work_BL'
RELAPACK_sgemmt(uplo, "N", "T", &n2, &n1, MONE, A_BL, ldA, Work_BL, ldWork, ONE, A_BR, ldA); RELAPACK_sgemmt(uplo, "N", "T", &n2, &n1, MONE, A_BL, ldA, Work_BL, ldWork, ONE, A_BR, ldA);
BLAS(sgemm)("N", "T", &n_rest, &n2, &n1, MONE, A_BL_B, ldA, Work_BL, ldWork, ONE, A_BR_B, ldA); BLAS(sgemm)("N", "T", &n_rest, &n2, &n1, MONE, A_BL_B, ldA, Work_BL, ldWork, ONE, A_BR_B, ldA);
// recursion(A_BR) // recursion(A_BR)
int n2_out; blasint n2_out;
RELAPACK_ssytrf_rec(uplo, &n_full2, &n2, &n2_out, A_BR, ldA, ipiv_B, Work_BR, &ldWork_BR, &info2); RELAPACK_ssytrf_rec(uplo, &n_full2, &n2, &n2_out, A_BR, ldA, ipiv_B, Work_BR, &ldWork_BR, &info2);
if (n2_out != n2) { if (n2_out != n2) {
// undo 1 column of updates // undo 1 column of updates
const int n_restp1 = n_rest + 1; const blasint n_restp1 = n_rest + 1;
// last column of A_BR // last column of A_BR
float *const A_BR_r = A_BR + *ldA * n2_out + n2_out; float *const A_BR_r = A_BR + *ldA * n2_out + n2_out;
@ -182,22 +181,22 @@ static void RELAPACK_ssytrf_rec(
*n_out = n1 + n2; *n_out = n1 + n2;
} else { } else {
// Splitting (setup) // Splitting (setup)
int n2 = SREC_SPLIT(*n); blasint n2 = SREC_SPLIT(*n);
int n1 = *n - n2; blasint n1 = *n - n2;
// * Work_R // * Work_R
// (top recursion level: use Work as Work_R) // (top recursion level: use Work as Work_R)
float *const Work_R = top ? Work : Work + *ldWork * n1; float *const Work_R = top ? Work : Work + *ldWork * n1;
// recursion(A_R) // recursion(A_R)
int n2_out; blasint n2_out;
RELAPACK_ssytrf_rec(uplo, n_full, &n2, &n2_out, A, ldA, ipiv, Work_R, ldWork, &info2); RELAPACK_ssytrf_rec(uplo, n_full, &n2, &n2_out, A, ldA, ipiv, Work_R, ldWork, &info2);
const int n2_diff = n2 - n2_out; const blasint n2_diff = n2 - n2_out;
n2 = n2_out; n2 = n2_out;
// Splitting (continued) // Splitting (continued)
n1 = *n - n2; n1 = *n - n2;
const int n_full1 = *n_full - n2; const blasint n_full1 = *n_full - n2;
// * A_TL_T A_TR_T // * A_TL_T A_TR_T
// * A_TL A_TR // * A_TL A_TR
@ -213,19 +212,19 @@ static void RELAPACK_ssytrf_rec(
// (top recursion level: Work_R was Work) // (top recursion level: Work_R was Work)
float *const Work_L = Work; float *const Work_L = Work;
float *const Work_TR = Work + *ldWork * (top ? n2_diff : n1) + n_rest; float *const Work_TR = Work + *ldWork * (top ? n2_diff : n1) + n_rest;
const int ldWork_L = top ? n1 : *ldWork; const blasint ldWork_L = top ? n1 : *ldWork;
// A_TL = A_TL - A_TR Work_TR' // A_TL = A_TL - A_TR Work_TR'
RELAPACK_sgemmt(uplo, "N", "T", &n1, &n2, MONE, A_TR, ldA, Work_TR, ldWork, ONE, A_TL, ldA); RELAPACK_sgemmt(uplo, "N", "T", &n1, &n2, MONE, A_TR, ldA, Work_TR, ldWork, ONE, A_TL, ldA);
BLAS(sgemm)("N", "T", &n_rest, &n1, &n2, MONE, A_TR_T, ldA, Work_TR, ldWork, ONE, A_TL_T, ldA); BLAS(sgemm)("N", "T", &n_rest, &n1, &n2, MONE, A_TR_T, ldA, Work_TR, ldWork, ONE, A_TL_T, ldA);
// recursion(A_TL) // recursion(A_TL)
int n1_out; blasint n1_out;
RELAPACK_ssytrf_rec(uplo, &n_full1, &n1, &n1_out, A, ldA, ipiv, Work_L, &ldWork_L, &info1); RELAPACK_ssytrf_rec(uplo, &n_full1, &n1, &n1_out, A, ldA, ipiv, Work_L, &ldWork_L, &info1);
if (n1_out != n1) { if (n1_out != n1) {
// undo 1 column of updates // undo 1 column of updates
const int n_restp1 = n_rest + 1; const blasint n_restp1 = n_rest + 1;
// A_TL_T_l = A_TL_T_l + A_TR_T Work_TR_t' // A_TL_T_l = A_TL_T_l + A_TR_T Work_TR_t'
BLAS(sgemv)("N", &n_restp1, &n2, ONE, A_TR_T, ldA, Work_TR, ldWork, ONE, A_TL_T, iONE); BLAS(sgemv)("N", &n_restp1, &n2, ONE, A_TR_T, ldA, Work_TR, ldWork, ONE, A_TL_T, iONE);

28
relapack/src/ssytrf_rec2.c
View File

@ -14,7 +14,7 @@
/* Table of constant values */ /* Table of constant values */
static int c__1 = 1; static blasint c__1 = 1;
static float c_b8 = -1.f; static float c_b8 = -1.f;
static float c_b9 = 1.f; static float c_b9 = 1.f;
@ -25,32 +25,32 @@ static float c_b9 = 1.f;
* The blocked BLAS Level 3 updates were removed and moved to the * The blocked BLAS Level 3 updates were removed and moved to the
* recursive algorithm. * recursive algorithm.
* */ * */
/* Subroutine */ void RELAPACK_ssytrf_rec2(char *uplo, int *n, int * /* Subroutine */ void RELAPACK_ssytrf_rec2(char *uplo, blasint *n, blasint *
nb, int *kb, float *a, int *lda, int *ipiv, float *w, nb, blasint *kb, float *a, blasint *lda, blasint *ipiv, float *w,
int *ldw, int *info, ftnlen uplo_len) int *ldw, blasint *info, ftnlen uplo_len)
{ {
/* System generated locals */ /* System generated locals */
int a_dim1, a_offset, w_dim1, w_offset, i__1, i__2; blasint a_dim1, a_offset, w_dim1, w_offset, i__1, i__2;
float r__1, r__2, r__3; float r__1, r__2, r__3;
/* Builtin functions */ /* Builtin functions */
double sqrt(double); double sqrt(double);
/* Local variables */ /* Local variables */
static int j, k; static blasint j, k;
static float t, r1, d11, d21, d22; static float t, r1, d11, d21, d22;
static int jj, kk, jp, kp, kw, kkw, imax, jmax; static blasint jj, kk, jp, kp, kw, kkw, imax, jmax;
static float alpha; static float alpha;
extern logical lsame_(char *, char *, ftnlen, ftnlen); extern logical lsame_(char *, char *, ftnlen, ftnlen);
extern /* Subroutine */ int sscal_(int *, float *, float *, int *), extern /* Subroutine */ blasint sscal_(int *, float *, float *, blasint *),
sgemv_(char *, int *, int *, float *, float *, int *, sgemv_(char *, blasint *, blasint *, float *, float *, blasint *,
float *, int *, float *, float *, int *, ftnlen); float *, blasint *, float *, float *, blasint *, ftnlen);
static int kstep; static blasint kstep;
extern /* Subroutine */ int scopy_(int *, float *, int *, float *, extern /* Subroutine */ blasint scopy_(int *, float *, blasint *, float *,
int *), sswap_(int *, float *, int *, float *, int * blasint *), sswap_(int *, float *, blasint *, float *, blasint *
); );
static float absakk; static float absakk;
extern int isamax_(int *, float *, int *); extern blasint isamax_(int *, float *, blasint *);
static float colmax, rowmax; static float colmax, rowmax;
/* Parameter adjustments */ /* Parameter adjustments */

72
relapack/src/ssytrf_rook.c
View File

@ -3,8 +3,8 @@
#include <stdlib.h> #include <stdlib.h>
#endif #endif
static void RELAPACK_ssytrf_rook_rec(const char *, const int *, const int *, int *, static void RELAPACK_ssytrf_rook_rec(const char *, const blasint *, const blasint *, blasint *,
float *, const int *, int *, float *, const int *, int *); float *, const blasint *, blasint *, float *, const blasint *, blasint *);
/** SSYTRF_ROOK computes the factorization of a real symmetric matrix A using the bounded Bunch-Kaufman ("rook") diagonal pivoting method. /** SSYTRF_ROOK computes the factorization of a real symmetric matrix A using the bounded Bunch-Kaufman ("rook") diagonal pivoting method.
@ -14,21 +14,21 @@ static void RELAPACK_ssytrf_rook_rec(const char *, const int *, const int *, int
* http://www.netlib.org/lapack/explore-html/de/da4/ssytrf__rook_8f.html * http://www.netlib.org/lapack/explore-html/de/da4/ssytrf__rook_8f.html
* */ * */
void RELAPACK_ssytrf_rook( void RELAPACK_ssytrf_rook(
const char *uplo, const int *n, const char *uplo, const blasint *n,
float *A, const int *ldA, int *ipiv, float *A, const blasint *ldA, blasint *ipiv,
float *Work, const int *lWork, int *info float *Work, const blasint *lWork, blasint *info
) { ) {
// Required work size // Required work size
const int cleanlWork = *n * (*n / 2); const blasint cleanlWork = *n * (*n / 2);
int minlWork = cleanlWork; blasint minlWork = cleanlWork;
#if XSYTRF_ALLOW_MALLOC #if XSYTRF_ALLOW_MALLOC
minlWork = 1; minlWork = 1;
#endif #endif
// Check arguments // Check arguments
const int lower = LAPACK(lsame)(uplo, "L"); const blasint lower = LAPACK(lsame)(uplo, "L");
const int upper = LAPACK(lsame)(uplo, "U"); const blasint upper = LAPACK(lsame)(uplo, "U");
*info = 0; *info = 0;
if (!lower && !upper) if (!lower && !upper)
*info = -1; *info = -1;
@ -55,8 +55,8 @@ void RELAPACK_ssytrf_rook(
#endif #endif
if (*info) { if (*info) {
const int minfo = -*info; const blasint minfo = -*info;
LAPACK(xerbla)("SSYTRF", &minfo); LAPACK(xerbla)("SSYTRF", &minfo, strlen("SSYTRF"));
return; return;
} }
@ -64,7 +64,7 @@ void RELAPACK_ssytrf_rook(
const char cleanuplo = lower ? 'L' : 'U'; const char cleanuplo = lower ? 'L' : 'U';
// Dummy argument // Dummy argument
int nout; blasint nout;
// Recursive kernel // Recursive kernel
RELAPACK_ssytrf_rook_rec(&cleanuplo, n, n, &nout, A, ldA, ipiv, cleanWork, n, info); RELAPACK_ssytrf_rook_rec(&cleanuplo, n, n, &nout, A, ldA, ipiv, cleanWork, n, info);
@ -78,13 +78,13 @@ void RELAPACK_ssytrf_rook(
/** ssytrf_rook's recursive compute kernel */ /** ssytrf_rook's recursive compute kernel */
static void RELAPACK_ssytrf_rook_rec( static void RELAPACK_ssytrf_rook_rec(
const char *uplo, const int *n_full, const int *n, int *n_out, const char *uplo, const blasint *n_full, const blasint *n, blasint *n_out,
float *A, const int *ldA, int *ipiv, float *A, const blasint *ldA, blasint *ipiv,
float *Work, const int *ldWork, int *info float *Work, const blasint *ldWork, blasint *info
) { ) {
// top recursion level? // top recursion level?
const int top = *n_full == *n; const blasint top = *n_full == *n;
if (*n <= MAX(CROSSOVER_SSYTRF_ROOK, 3)) { if (*n <= MAX(CROSSOVER_SSYTRF_ROOK, 3)) {
// Unblocked // Unblocked
@ -96,31 +96,31 @@ static void RELAPACK_ssytrf_rook_rec(
return; return;
} }
int info1, info2; blasint info1, info2;
// Constants // Constants
const float ONE[] = { 1. }; const float ONE[] = { 1. };
const float MONE[] = { -1. }; const float MONE[] = { -1. };
const int iONE[] = { 1 }; const blasint iONE[] = { 1 };
const int n_rest = *n_full - *n; const blasint n_rest = *n_full - *n;
if (*uplo == 'L') { if (*uplo == 'L') {
// Splitting (setup) // Splitting (setup)
int n1 = SREC_SPLIT(*n); blasint n1 = SREC_SPLIT(*n);
int n2 = *n - n1; blasint n2 = *n - n1;
// Work_L * // Work_L *
float *const Work_L = Work; float *const Work_L = Work;
// recursion(A_L) // recursion(A_L)
int n1_out; blasint n1_out;
RELAPACK_ssytrf_rook_rec(uplo, n_full, &n1, &n1_out, A, ldA, ipiv, Work_L, ldWork, &info1); RELAPACK_ssytrf_rook_rec(uplo, n_full, &n1, &n1_out, A, ldA, ipiv, Work_L, ldWork, &info1);
n1 = n1_out; n1 = n1_out;
// Splitting (continued) // Splitting (continued)
n2 = *n - n1; n2 = *n - n1;
const int n_full2 = *n_full - n1; const blasint n_full2 = *n_full - n1;
// * * // * *
// A_BL A_BR // A_BL A_BR
@ -136,23 +136,23 @@ static void RELAPACK_ssytrf_rook_rec(
// (top recursion level: use Work as Work_BR) // (top recursion level: use Work as Work_BR)
float *const Work_BL = Work + n1; float *const Work_BL = Work + n1;
float *const Work_BR = top ? Work : Work + *ldWork * n1 + n1; float *const Work_BR = top ? Work : Work + *ldWork * n1 + n1;
const int ldWork_BR = top ? n2 : *ldWork; const blasint ldWork_BR = top ? n2 : *ldWork;
// ipiv_T // ipiv_T
// ipiv_B // ipiv_B
int *const ipiv_B = ipiv + n1; blasint *const ipiv_B = ipiv + n1;
// A_BR = A_BR - A_BL Work_BL' // A_BR = A_BR - A_BL Work_BL'
RELAPACK_sgemmt(uplo, "N", "T", &n2, &n1, MONE, A_BL, ldA, Work_BL, ldWork, ONE, A_BR, ldA); RELAPACK_sgemmt(uplo, "N", "T", &n2, &n1, MONE, A_BL, ldA, Work_BL, ldWork, ONE, A_BR, ldA);
BLAS(sgemm)("N", "T", &n_rest, &n2, &n1, MONE, A_BL_B, ldA, Work_BL, ldWork, ONE, A_BR_B, ldA); BLAS(sgemm)("N", "T", &n_rest, &n2, &n1, MONE, A_BL_B, ldA, Work_BL, ldWork, ONE, A_BR_B, ldA);
// recursion(A_BR) // recursion(A_BR)
int n2_out; blasint n2_out;
RELAPACK_ssytrf_rook_rec(uplo, &n_full2, &n2, &n2_out, A_BR, ldA, ipiv_B, Work_BR, &ldWork_BR, &info2); RELAPACK_ssytrf_rook_rec(uplo, &n_full2, &n2, &n2_out, A_BR, ldA, ipiv_B, Work_BR, &ldWork_BR, &info2);
if (n2_out != n2) { if (n2_out != n2) {
// undo 1 column of updates // undo 1 column of updates
const int n_restp1 = n_rest + 1; const blasint n_restp1 = n_rest + 1;
// last column of A_BR // last column of A_BR
float *const A_BR_r = A_BR + *ldA * n2_out + n2_out; float *const A_BR_r = A_BR + *ldA * n2_out + n2_out;
@ -169,7 +169,7 @@ static void RELAPACK_ssytrf_rook_rec(
n2 = n2_out; n2 = n2_out;
// shift pivots // shift pivots
int i; blasint i;
for (i = 0; i < n2; i++) for (i = 0; i < n2; i++)
if (ipiv_B[i] > 0) if (ipiv_B[i] > 0)
ipiv_B[i] += n1; ipiv_B[i] += n1;
@ -180,22 +180,22 @@ static void RELAPACK_ssytrf_rook_rec(
*n_out = n1 + n2; *n_out = n1 + n2;
} else { } else {
// Splitting (setup) // Splitting (setup)
int n2 = SREC_SPLIT(*n); blasint n2 = SREC_SPLIT(*n);
int n1 = *n - n2; blasint n1 = *n - n2;
// * Work_R // * Work_R
// (top recursion level: use Work as Work_R) // (top recursion level: use Work as Work_R)
float *const Work_R = top ? Work : Work + *ldWork * n1; float *const Work_R = top ? Work : Work + *ldWork * n1;
// recursion(A_R) // recursion(A_R)
int n2_out; blasint n2_out;
RELAPACK_ssytrf_rook_rec(uplo, n_full, &n2, &n2_out, A, ldA, ipiv, Work_R, ldWork, &info2); RELAPACK_ssytrf_rook_rec(uplo, n_full, &n2, &n2_out, A, ldA, ipiv, Work_R, ldWork, &info2);
const int n2_diff = n2 - n2_out; const blasint n2_diff = n2 - n2_out;
n2 = n2_out; n2 = n2_out;
// Splitting (continued) // Splitting (continued)
n1 = *n - n2; n1 = *n - n2;
const int n_full1 = *n_full - n2; const blasint n_full1 = *n_full - n2;
// * A_TL_T A_TR_T // * A_TL_T A_TR_T
// * A_TL A_TR // * A_TL A_TR
@ -211,19 +211,19 @@ static void RELAPACK_ssytrf_rook_rec(
// (top recursion level: Work_R was Work) // (top recursion level: Work_R was Work)
float *const Work_L = Work; float *const Work_L = Work;
float *const Work_TR = Work + *ldWork * (top ? n2_diff : n1) + n_rest; float *const Work_TR = Work + *ldWork * (top ? n2_diff : n1) + n_rest;
const int ldWork_L = top ? n1 : *ldWork; const blasint ldWork_L = top ? n1 : *ldWork;
// A_TL = A_TL - A_TR Work_TR' // A_TL = A_TL - A_TR Work_TR'
RELAPACK_sgemmt(uplo, "N", "T", &n1, &n2, MONE, A_TR, ldA, Work_TR, ldWork, ONE, A_TL, ldA); RELAPACK_sgemmt(uplo, "N", "T", &n1, &n2, MONE, A_TR, ldA, Work_TR, ldWork, ONE, A_TL, ldA);
BLAS(sgemm)("N", "T", &n_rest, &n1, &n2, MONE, A_TR_T, ldA, Work_TR, ldWork, ONE, A_TL_T, ldA); BLAS(sgemm)("N", "T", &n_rest, &n1, &n2, MONE, A_TR_T, ldA, Work_TR, ldWork, ONE, A_TL_T, ldA);
// recursion(A_TL) // recursion(A_TL)
int n1_out; blasint n1_out;
RELAPACK_ssytrf_rook_rec(uplo, &n_full1, &n1, &n1_out, A, ldA, ipiv, Work_L, &ldWork_L, &info1); RELAPACK_ssytrf_rook_rec(uplo, &n_full1, &n1, &n1_out, A, ldA, ipiv, Work_L, &ldWork_L, &info1);
if (n1_out != n1) { if (n1_out != n1) {
// undo 1 column of updates // undo 1 column of updates
const int n_restp1 = n_rest + 1; const blasint n_restp1 = n_rest + 1;
// A_TL_T_l = A_TL_T_l + A_TR_T Work_TR_t' // A_TL_T_l = A_TL_T_l + A_TR_T Work_TR_t'
BLAS(sgemv)("N", &n_restp1, &n2, ONE, A_TR_T, ldA, Work_TR, ldWork, ONE, A_TL_T, iONE); BLAS(sgemv)("N", &n_restp1, &n2, ONE, A_TR_T, ldA, Work_TR, ldWork, ONE, A_TL_T, iONE);

32
relapack/src/ssytrf_rook_rec2.c
View File

@ -14,7 +14,7 @@
/* Table of constant values */ /* Table of constant values */
static int c__1 = 1; static blasint c__1 = 1;
static float c_b9 = -1.f; static float c_b9 = -1.f;
static float c_b10 = 1.f; static float c_b10 = 1.f;
@ -25,39 +25,39 @@ static float c_b10 = 1.f;
* The blocked BLAS Level 3 updates were removed and moved to the * The blocked BLAS Level 3 updates were removed and moved to the
* recursive algorithm. * recursive algorithm.
* */ * */
/* Subroutine */ void RELAPACK_ssytrf_rook_rec2(char *uplo, int *n, /* Subroutine */ void RELAPACK_ssytrf_rook_rec2(char *uplo, blasint *n,
int *nb, int *kb, float *a, int *lda, int *ipiv, float * int *nb, blasint *kb, float *a, blasint *lda, blasint *ipiv, float *
w, int *ldw, int *info, ftnlen uplo_len) w, blasint *ldw, blasint *info, ftnlen uplo_len)
{ {
/* System generated locals */ /* System generated locals */
int a_dim1, a_offset, w_dim1, w_offset, i__1, i__2; blasint a_dim1, a_offset, w_dim1, w_offset, i__1, i__2;
float r__1; float r__1;
/* Builtin functions */ /* Builtin functions */
double sqrt(double); double sqrt(double);
/* Local variables */ /* Local variables */
static int j, k, p; static blasint j, k, p;
static float t, r1, d11, d12, d21, d22; static float t, r1, d11, d12, d21, d22;
static int ii, jj, kk, kp, kw, jp1, jp2, kkw; static blasint ii, jj, kk, kp, kw, jp1, jp2, kkw;
static logical done; static logical done;
static int imax, jmax; static blasint imax, jmax;
static float alpha; static float alpha;
extern logical lsame_(char *, char *, ftnlen, ftnlen); extern logical lsame_(char *, char *, ftnlen, ftnlen);
extern /* Subroutine */ int sscal_(int *, float *, float *, int *); extern /* Subroutine */ blasint sscal_(int *, float *, float *, blasint *);
static float sfmin; static float sfmin;
static int itemp; static blasint itemp;
extern /* Subroutine */ int sgemv_(char *, int *, int *, float *, extern /* Subroutine */ blasint sgemv_(char *, blasint *, blasint *, float *,
float *, int *, float *, int *, float *, float *, int *, float *, blasint *, float *, blasint *, float *, float *, blasint *,
ftnlen); ftnlen);
static int kstep; static blasint kstep;
static float stemp; static float stemp;
extern /* Subroutine */ int scopy_(int *, float *, int *, float *, extern /* Subroutine */ blasint scopy_(int *, float *, blasint *, float *,
int *), sswap_(int *, float *, int *, float *, int * blasint *), sswap_(int *, float *, blasint *, float *, blasint *
); );
static float absakk; static float absakk;
extern double slamch_(char *, ftnlen); extern double slamch_(char *, ftnlen);
extern int isamax_(int *, float *, int *); extern blasint isamax_(int *, float *, blasint *);
static float colmax, rowmax; static float colmax, rowmax;
/* Parameter adjustments */ /* Parameter adjustments */

66
relapack/src/stgsyl.c
View File

@ -1,11 +1,11 @@
#include "relapack.h" #include "relapack.h"
#include <math.h> #include <math.h>
static void RELAPACK_stgsyl_rec(const char *, const int *, const int *, static void RELAPACK_stgsyl_rec(const char *, const blasint *, const blasint *,
const int *, const float *, const int *, const float *, const int *, const blasint *, const float *, const blasint *, const float *, const blasint *,
float *, const int *, const float *, const int *, const float *, float *, const blasint *, const float *, const blasint *, const float *,
const int *, float *, const int *, float *, float *, float *, int *, int *, const blasint *, float *, const blasint *, float *, float *, float *, blasint *, blasint *,
int *); blasint *);
/** STGSYL solves the generalized Sylvester equation. /** STGSYL solves the generalized Sylvester equation.
@ -15,21 +15,21 @@ static void RELAPACK_stgsyl_rec(const char *, const int *, const int *,
* http://www.netlib.org/lapack/explore-html/dc/d67/stgsyl_8f.html * http://www.netlib.org/lapack/explore-html/dc/d67/stgsyl_8f.html
* */ * */
void RELAPACK_stgsyl( void RELAPACK_stgsyl(
const char *trans, const int *ijob, const int *m, const int *n, const char *trans, const blasint *ijob, const blasint *m, const blasint *n,
const float *A, const int *ldA, const float *B, const int *ldB, const float *A, const blasint *ldA, const float *B, const blasint *ldB,
float *C, const int *ldC, float *C, const blasint *ldC,
const float *D, const int *ldD, const float *E, const int *ldE, const float *D, const blasint *ldD, const float *E, const blasint *ldE,
float *F, const int *ldF, float *F, const blasint *ldF,
float *scale, float *dif, float *scale, float *dif,
float *Work, const int *lWork, int *iWork, int *info float *Work, const blasint *lWork, blasint *iWork, blasint *info
) { ) {
// Parse arguments // Parse arguments
const int notran = LAPACK(lsame)(trans, "N"); const blasint notran = LAPACK(lsame)(trans, "N");
const int tran = LAPACK(lsame)(trans, "T"); const blasint tran = LAPACK(lsame)(trans, "T");
// Compute work buffer size // Compute work buffer size
int lwmin = 1; blasint lwmin = 1;
if (notran && (*ijob == 1 || *ijob == 2)) if (notran && (*ijob == 1 || *ijob == 2))
lwmin = MAX(1, 2 * *m * *n); lwmin = MAX(1, 2 * *m * *n);
*info = 0; *info = 0;
@ -58,8 +58,8 @@ void RELAPACK_stgsyl(
else if (*lWork < lwmin && *lWork != -1) else if (*lWork < lwmin && *lWork != -1)
*info = -20; *info = -20;
if (*info) { if (*info) {
const int minfo = -*info; const blasint minfo = -*info;
LAPACK(xerbla)("STGSYL", &minfo); LAPACK(xerbla)("STGSYL", &minfo, strlen("STGSYL"));
return; return;
} }
@ -75,8 +75,8 @@ void RELAPACK_stgsyl(
// Constant // Constant
const float ZERO[] = { 0. }; const float ZERO[] = { 0. };
int isolve = 1; blasint isolve = 1;
int ifunc = 0; blasint ifunc = 0;
if (notran) { if (notran) {
if (*ijob >= 3) { if (*ijob >= 3) {
ifunc = *ijob - 2; ifunc = *ijob - 2;
@ -87,12 +87,12 @@ void RELAPACK_stgsyl(
} }
float scale2; float scale2;
int iround; blasint iround;
for (iround = 1; iround <= isolve; iround++) { for (iround = 1; iround <= isolve; iround++) {
*scale = 1; *scale = 1;
float dscale = 0; float dscale = 0;
float dsum = 1; float dsum = 1;
int pq; blasint pq;
RELAPACK_stgsyl_rec(&cleantrans, &ifunc, m, n, A, ldA, B, ldB, C, ldC, D, ldD, E, ldE, F, ldF, scale, &dsum, &dscale, iWork, &pq, info); RELAPACK_stgsyl_rec(&cleantrans, &ifunc, m, n, A, ldA, B, ldB, C, ldC, D, ldD, E, ldE, F, ldF, scale, &dsum, &dscale, iWork, &pq, info);
if (dscale != 0) { if (dscale != 0) {
if (*ijob == 1 || *ijob == 3) if (*ijob == 1 || *ijob == 3)
@ -121,13 +121,13 @@ void RELAPACK_stgsyl(
/** stgsyl's recursive vompute kernel */ /** stgsyl's recursive vompute kernel */
static void RELAPACK_stgsyl_rec( static void RELAPACK_stgsyl_rec(
const char *trans, const int *ifunc, const int *m, const int *n, const char *trans, const blasint *ifunc, const blasint *m, const blasint *n,
const float *A, const int *ldA, const float *B, const int *ldB, const float *A, const blasint *ldA, const float *B, const blasint *ldB,
float *C, const int *ldC, float *C, const blasint *ldC,
const float *D, const int *ldD, const float *E, const int *ldE, const float *D, const blasint *ldD, const float *E, const blasint *ldE,
float *F, const int *ldF, float *F, const blasint *ldF,
float *scale, float *dsum, float *dscale, float *scale, float *dsum, float *dscale,
int *iWork, int *pq, int *info blasint *iWork, blasint *pq, blasint *info
) { ) {
if (*m <= MAX(CROSSOVER_STGSYL, 1) && *n <= MAX(CROSSOVER_STGSYL, 1)) { if (*m <= MAX(CROSSOVER_STGSYL, 1) && *n <= MAX(CROSSOVER_STGSYL, 1)) {
@ -139,20 +139,20 @@ static void RELAPACK_stgsyl_rec(
// Constants // Constants
const float ONE[] = { 1. }; const float ONE[] = { 1. };
const float MONE[] = { -1. }; const float MONE[] = { -1. };
const int iONE[] = { 1 }; const blasint iONE[] = { 1 };
// Outputs // Outputs
float scale1[] = { 1. }; float scale1[] = { 1. };
float scale2[] = { 1. }; float scale2[] = { 1. };
int info1[] = { 0 }; blasint info1[] = { 0 };
int info2[] = { 0 }; blasint info2[] = { 0 };
if (*m > *n) { if (*m > *n) {
// Splitting // Splitting
int m1 = SREC_SPLIT(*m); blasint m1 = SREC_SPLIT(*m);
if (A[m1 + *ldA * (m1 - 1)]) if (A[m1 + *ldA * (m1 - 1)])
m1++; m1++;
const int m2 = *m - m1; const blasint m2 = *m - m1;
// A_TL A_TR // A_TL A_TR
// 0 A_BR // 0 A_BR
@ -210,10 +210,10 @@ static void RELAPACK_stgsyl_rec(
} }
} else { } else {
// Splitting // Splitting
int n1 = SREC_SPLIT(*n); blasint n1 = SREC_SPLIT(*n);
if (B[n1 + *ldB * (n1 - 1)]) if (B[n1 + *ldB * (n1 - 1)])
n1++; n1++;
const int n2 = *n - n1; const blasint n2 = *n - n1;
// B_TL B_TR // B_TL B_TR
// 0 B_BR // 0 B_BR

56
relapack/src/strsyl.c
View File

@ -1,8 +1,8 @@
#include "relapack.h" #include "relapack.h"
static void RELAPACK_strsyl_rec(const char *, const char *, const int *, static void RELAPACK_strsyl_rec(const char *, const char *, const blasint *,
const int *, const int *, const float *, const int *, const float *, const blasint *, const blasint *, const float *, const blasint *, const float *,
const int *, float *, const int *, float *, int *); const blasint *, float *, const blasint *, float *, blasint *);
/** STRSYL solves the real Sylvester matrix equation. /** STRSYL solves the real Sylvester matrix equation.
@ -12,20 +12,20 @@ static void RELAPACK_strsyl_rec(const char *, const char *, const int *,
* http://www.netlib.org/lapack/explore-html/d4/d7d/strsyl_8f.html * http://www.netlib.org/lapack/explore-html/d4/d7d/strsyl_8f.html
* */ * */
void RELAPACK_strsyl( void RELAPACK_strsyl(
const char *tranA, const char *tranB, const int *isgn, const char *tranA, const char *tranB, const blasint *isgn,
const int *m, const int *n, const blasint *m, const blasint *n,
const float *A, const int *ldA, const float *B, const int *ldB, const float *A, const blasint *ldA, const float *B, const blasint *ldB,
float *C, const int *ldC, float *scale, float *C, const blasint *ldC, float *scale,
int *info blasint *info
) { ) {
// Check arguments // Check arguments
const int notransA = LAPACK(lsame)(tranA, "N"); const blasint notransA = LAPACK(lsame)(tranA, "N");
const int transA = LAPACK(lsame)(tranA, "T"); const blasint transA = LAPACK(lsame)(tranA, "T");
const int ctransA = LAPACK(lsame)(tranA, "C"); const blasint ctransA = LAPACK(lsame)(tranA, "C");
const int notransB = LAPACK(lsame)(tranB, "N"); const blasint notransB = LAPACK(lsame)(tranB, "N");
const int transB = LAPACK(lsame)(tranB, "T"); const blasint transB = LAPACK(lsame)(tranB, "T");
const int ctransB = LAPACK(lsame)(tranB, "C"); const blasint ctransB = LAPACK(lsame)(tranB, "C");
*info = 0; *info = 0;
if (!transA && !ctransA && !notransA) if (!transA && !ctransA && !notransA)
*info = -1; *info = -1;
@ -44,8 +44,8 @@ void RELAPACK_strsyl(
else if (*ldC < MAX(1, *m)) else if (*ldC < MAX(1, *m))
*info = -11; *info = -11;
if (*info) { if (*info) {
const int minfo = -*info; const blasint minfo = -*info;
LAPACK(xerbla)("STRSYL", &minfo); LAPACK(xerbla)("STRSYL", &minfo, strlen("STRSYL"));
return; return;
} }
@ -60,11 +60,11 @@ void RELAPACK_strsyl(
/** strsyl's recursive compute kernel */ /** strsyl's recursive compute kernel */
static void RELAPACK_strsyl_rec( static void RELAPACK_strsyl_rec(
const char *tranA, const char *tranB, const int *isgn, const char *tranA, const char *tranB, const blasint *isgn,
const int *m, const int *n, const blasint *m, const blasint *n,
const float *A, const int *ldA, const float *B, const int *ldB, const float *A, const blasint *ldA, const float *B, const blasint *ldB,
float *C, const int *ldC, float *scale, float *C, const blasint *ldC, float *scale,
int *info blasint *info
) { ) {
if (*m <= MAX(CROSSOVER_STRSYL, 1) && *n <= MAX(CROSSOVER_STRSYL, 1)) { if (*m <= MAX(CROSSOVER_STRSYL, 1) && *n <= MAX(CROSSOVER_STRSYL, 1)) {
@ -77,20 +77,20 @@ static void RELAPACK_strsyl_rec(
const float ONE[] = { 1. }; const float ONE[] = { 1. };
const float MONE[] = { -1. }; const float MONE[] = { -1. };
const float MSGN[] = { -*isgn }; const float MSGN[] = { -*isgn };
const int iONE[] = { 1 }; const blasint iONE[] = { 1 };
// Outputs // Outputs
float scale1[] = { 1. }; float scale1[] = { 1. };
float scale2[] = { 1. }; float scale2[] = { 1. };
int info1[] = { 0 }; blasint info1[] = { 0 };
int info2[] = { 0 }; blasint info2[] = { 0 };
if (*m > *n) { if (*m > *n) {
// Splitting // Splitting
int m1 = SREC_SPLIT(*m); blasint m1 = SREC_SPLIT(*m);
if (A[m1 + *ldA * (m1 - 1)]) if (A[m1 + *ldA * (m1 - 1)])
m1++; m1++;
const int m2 = *m - m1; const blasint m2 = *m - m1;
// A_TL A_TR // A_TL A_TR
// 0 A_BR // 0 A_BR
@ -126,10 +126,10 @@ static void RELAPACK_strsyl_rec(
} }
} else { } else {
// Splitting // Splitting
int n1 = SREC_SPLIT(*n); blasint n1 = SREC_SPLIT(*n);
if (B[n1 + *ldB * (n1 - 1)]) if (B[n1 + *ldB * (n1 - 1)])
n1++; n1++;
const int n2 = *n - n1; const blasint n2 = *n - n1;
// B_TL B_TR // B_TL B_TR
// 0 B_BR // 0 B_BR

50
relapack/src/strsyl_rec2.c
View File

@ -14,48 +14,48 @@
/* Table of constant values */ /* Table of constant values */
static int c__1 = 1; static blasint c__1 = 1;
static int c_false = FALSE_; static blasint c_false = FALSE_;
static int c__2 = 2; static blasint c__2 = 2;
static float c_b26 = 1.f; static float c_b26 = 1.f;
static float c_b30 = 0.f; static float c_b30 = 0.f;
static int c_true = TRUE_; static blasint c_true = TRUE_;
void RELAPACK_strsyl_rec2(char *trana, char *tranb, int *isgn, int void RELAPACK_strsyl_rec2(char *trana, char *tranb, blasint *isgn, int
*m, int *n, float *a, int *lda, float *b, int *ldb, float * *m, blasint *n, float *a, blasint *lda, float *b, blasint *ldb, float *
c__, int *ldc, float *scale, int *info, ftnlen trana_len, c__, blasint *ldc, float *scale, blasint *info, ftnlen trana_len,
ftnlen tranb_len) ftnlen tranb_len)
{ {
/* System generated locals */ /* System generated locals */
int a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2, blasint a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2,
i__3, i__4; i__3, i__4;
float r__1, r__2; float r__1, r__2;
/* Local variables */ /* Local variables */
static int j, k, l; static blasint j, k, l;
static float x[4] /* was [2][2] */; static float x[4] /* was [2][2] */;
static int k1, k2, l1, l2; static blasint k1, k2, l1, l2;
static float a11, db, da11, vec[4] /* was [2][2] */, dum[1], eps, sgn; static float a11, db, da11, vec[4] /* was [2][2] */, dum[1], eps, sgn;
static int ierr; static blasint ierr;
static float smin; static float smin;
extern float sdot_(int *, float *, int *, float *, int *); extern float sdot_(int *, float *, blasint *, float *, blasint *);
static float suml, sumr; static float suml, sumr;
extern int lsame_(char *, char *, ftnlen, ftnlen); extern blasint lsame_(char *, char *, ftnlen, ftnlen);
extern /* Subroutine */ int sscal_(int *, float *, float *, int *); extern /* Subroutine */ blasint sscal_(int *, float *, float *, blasint *);
static int knext, lnext; static blasint knext, lnext;
static float xnorm; static float xnorm;
extern /* Subroutine */ int slaln2_(int *, int *, int *, float extern /* Subroutine */ blasint slaln2_(int *, blasint *, blasint *, float
*, float *, float *, int *, float *, float *, float *, int *, *, float *, float *, blasint *, float *, float *, float *, blasint *,
float *, float *, float *, int *, float *, float *, int *), float *, float *, float *, blasint *, float *, float *, blasint *),
slasy2_(int *, int *, int *, int *, int *, slasy2_(int *, blasint *, blasint *, blasint *, blasint *,
float *, int *, float *, int *, float *, int *, float *, float *, blasint *, float *, blasint *, float *, blasint *, float *,
float *, int *, float *, int *), slabad_(float *, float *); float *, blasint *, float *, blasint *), slabad_(float *, float *);
static float scaloc; static float scaloc;
extern float slamch_(char *, ftnlen), slange_(char *, int *, extern float slamch_(char *, ftnlen), slange_(char *, blasint *,
int *, float *, int *, float *, ftnlen); blasint *, float *, blasint *, float *, ftnlen);
extern /* Subroutine */ int xerbla_(char *, int *, ftnlen); extern /* Subroutine */ blasint xerbla_(char *, blasint *, ftnlen);
static float bignum; static float bignum;
static int notrna, notrnb; static blasint notrna, notrnb;
static float smlnum; static float smlnum;
/* Parameter adjustments */ /* Parameter adjustments */

34
relapack/src/strtri.c
View File

@ -1,7 +1,7 @@
#include "relapack.h" #include "relapack.h"
static void RELAPACK_strtri_rec(const char *, const char *, const int *, static void RELAPACK_strtri_rec(const char *, const char *, const blasint *,
float *, const int *, int *); float *, const blasint *, blasint *);
/** CTRTRI computes the inverse of a real upper or lower triangular matrix A. /** CTRTRI computes the inverse of a real upper or lower triangular matrix A.
@ -11,16 +11,16 @@ static void RELAPACK_strtri_rec(const char *, const char *, const int *,
* http://www.netlib.org/lapack/explore-html/de/d76/strtri_8f.html * http://www.netlib.org/lapack/explore-html/de/d76/strtri_8f.html
* */ * */
void RELAPACK_strtri( void RELAPACK_strtri(
const char *uplo, const char *diag, const int *n, const char *uplo, const char *diag, const blasint *n,
float *A, const int *ldA, float *A, const blasint *ldA,
int *info blasint *info
) { ) {
// Check arguments // Check arguments
const int lower = LAPACK(lsame)(uplo, "L"); const blasint lower = LAPACK(lsame)(uplo, "L");
const int upper = LAPACK(lsame)(uplo, "U"); const blasint upper = LAPACK(lsame)(uplo, "U");
const int nounit = LAPACK(lsame)(diag, "N"); const blasint nounit = LAPACK(lsame)(diag, "N");
const int unit = LAPACK(lsame)(diag, "U"); const blasint unit = LAPACK(lsame)(diag, "U");
*info = 0; *info = 0;
if (!lower && !upper) if (!lower && !upper)
*info = -1; *info = -1;
@ -31,8 +31,8 @@ void RELAPACK_strtri(
else if (*ldA < MAX(1, *n)) else if (*ldA < MAX(1, *n))
*info = -5; *info = -5;
if (*info) { if (*info) {
const int minfo = -*info; const blasint minfo = -*info;
LAPACK(xerbla)("STRTRI", &minfo); LAPACK(xerbla)("STRTRI", &minfo, strlen("STRTRI"));
return; return;
} }
@ -42,7 +42,7 @@ void RELAPACK_strtri(
// check for singularity // check for singularity
if (nounit) { if (nounit) {
int i; blasint i;
for (i = 0; i < *n; i++) for (i = 0; i < *n; i++)
if (A[i + *ldA * i] == 0) { if (A[i + *ldA * i] == 0) {
*info = i; *info = i;
@ -57,9 +57,9 @@ void RELAPACK_strtri(
/** strtri's recursive compute kernel */ /** strtri's recursive compute kernel */
static void RELAPACK_strtri_rec( static void RELAPACK_strtri_rec(
const char *uplo, const char *diag, const int *n, const char *uplo, const char *diag, const blasint *n,
float *A, const int *ldA, float *A, const blasint *ldA,
int *info blasint *info
){ ){
if (*n <= MAX(CROSSOVER_STRTRI, 1)) { if (*n <= MAX(CROSSOVER_STRTRI, 1)) {
@ -73,8 +73,8 @@ static void RELAPACK_strtri_rec(
const float MONE[] = { -1. }; const float MONE[] = { -1. };
// Splitting // Splitting
const int n1 = SREC_SPLIT(*n); const blasint n1 = SREC_SPLIT(*n);
const int n2 = *n - n1; const blasint n2 = *n - n1;
// A_TL A_TR // A_TL A_TR
// A_BL A_BR // A_BL A_BR

78
relapack/src/zgbtrf.c
View File

@ -1,9 +1,9 @@
#include "relapack.h" #include "relapack.h"
#include "stdlib.h" #include "stdlib.h"
static void RELAPACK_zgbtrf_rec(const int *, const int *, const int *, static void RELAPACK_zgbtrf_rec(const blasint *, const blasint *, const blasint *,
const int *, double *, const int *, int *, double *, const int *, double *, const blasint *, double *, const blasint *, blasint *, double *, const blasint *, double *,
const int *, int *); const blasint *, blasint *);
/** ZGBTRF computes an LU factorization of a complex m-by-n band matrix A using partial pivoting with row interchanges. /** ZGBTRF computes an LU factorization of a complex m-by-n band matrix A using partial pivoting with row interchanges.
@ -13,9 +13,9 @@ static void RELAPACK_zgbtrf_rec(const int *, const int *, const int *,
* http://www.netlib.org/lapack/explore-html/dc/dcb/zgbtrf_8f.html * http://www.netlib.org/lapack/explore-html/dc/dcb/zgbtrf_8f.html
* */ * */
void RELAPACK_zgbtrf( void RELAPACK_zgbtrf(
const int *m, const int *n, const int *kl, const int *ku, const blasint *m, const blasint *n, const blasint *kl, const blasint *ku,
double *Ab, const int *ldAb, int *ipiv, double *Ab, const blasint *ldAb, blasint *ipiv,
int *info blasint *info
) { ) {
// Check arguments // Check arguments
@ -31,8 +31,8 @@ void RELAPACK_zgbtrf(
else if (*ldAb < 2 * *kl + *ku + 1) else if (*ldAb < 2 * *kl + *ku + 1)
*info = -6; *info = -6;
if (*info) { if (*info) {
const int minfo = -*info; const blasint minfo = -*info;
LAPACK(xerbla)("ZGBTRF", &minfo); LAPACK(xerbla)("ZGBTRF", &minfo, strlen("ZGBTRF"));
return; return;
} }
@ -40,14 +40,14 @@ void RELAPACK_zgbtrf(
const double ZERO[] = { 0., 0. }; const double ZERO[] = { 0., 0. };
// Result upper band width // Result upper band width
const int kv = *ku + *kl; const blasint kv = *ku + *kl;
// Unskew A // Unskew A
const int ldA[] = { *ldAb - 1 }; const blasint ldA[] = { *ldAb - 1 };
double *const A = Ab + 2 * kv; double *const A = Ab + 2 * kv;
// Zero upper diagonal fill-in elements // Zero upper diagonal fill-in elements
int i, j; blasint i, j;
for (j = 0; j < *n; j++) { for (j = 0; j < *n; j++) {
double *const A_j = A + 2 * *ldA * j; double *const A_j = A + 2 * *ldA * j;
for (i = MAX(0, j - kv); i < j - *ku; i++) for (i = MAX(0, j - kv); i < j - *ku; i++)
@ -55,11 +55,11 @@ void RELAPACK_zgbtrf(
} }
// Allocate work space // Allocate work space
const int n1 = ZREC_SPLIT(*n); const blasint n1 = ZREC_SPLIT(*n);
const int mWorkl = (kv > n1) ? MAX(1, *m - *kl) : kv; const blasint mWorkl = (kv > n1) ? MAX(1, *m - *kl) : kv;
const int nWorkl = (kv > n1) ? n1 : kv; const blasint nWorkl = (kv > n1) ? n1 : kv;
const int mWorku = (*kl > n1) ? n1 : *kl; const blasint mWorku = (*kl > n1) ? n1 : *kl;
const int nWorku = (*kl > n1) ? MAX(0, *n - *kl) : *kl; const blasint nWorku = (*kl > n1) ? MAX(0, *n - *kl) : *kl;
double *Workl = malloc(mWorkl * nWorkl * 2 * sizeof(double)); double *Workl = malloc(mWorkl * nWorkl * 2 * sizeof(double));
double *Worku = malloc(mWorku * nWorku * 2 * sizeof(double)); double *Worku = malloc(mWorku * nWorku * 2 * sizeof(double));
LAPACK(zlaset)("L", &mWorkl, &nWorkl, ZERO, ZERO, Workl, &mWorkl); LAPACK(zlaset)("L", &mWorkl, &nWorkl, ZERO, ZERO, Workl, &mWorkl);
@ -76,10 +76,10 @@ void RELAPACK_zgbtrf(
/** zgbtrf's recursive compute kernel */ /** zgbtrf's recursive compute kernel */
static void RELAPACK_zgbtrf_rec( static void RELAPACK_zgbtrf_rec(
const int *m, const int *n, const int *kl, const int *ku, const blasint *m, const blasint *n, const blasint *kl, const blasint *ku,
double *Ab, const int *ldAb, int *ipiv, double *Ab, const blasint *ldAb, blasint *ipiv,
double *Workl, const int *ldWorkl, double *Worku, const int *ldWorku, double *Workl, const blasint *ldWorkl, double *Worku, const blasint *ldWorku,
int *info blasint *info
) { ) {
if (*n <= MAX(CROSSOVER_ZGBTRF, 1)) { if (*n <= MAX(CROSSOVER_ZGBTRF, 1)) {
@ -91,25 +91,25 @@ static void RELAPACK_zgbtrf_rec(
// Constants // Constants
const double ONE[] = { 1., 0. }; const double ONE[] = { 1., 0. };
const double MONE[] = { -1., 0. }; const double MONE[] = { -1., 0. };
const int iONE[] = { 1 }; const blasint iONE[] = { 1 };
// Loop iterators // Loop iterators
int i, j; blasint i, j;
// Output upper band width // Output upper band width
const int kv = *ku + *kl; const blasint kv = *ku + *kl;
// Unskew A // Unskew A
const int ldA[] = { *ldAb - 1 }; const blasint ldA[] = { *ldAb - 1 };
double *const A = Ab + 2 * kv; double *const A = Ab + 2 * kv;
// Splitting // Splitting
const int n1 = MIN(ZREC_SPLIT(*n), *kl); const blasint n1 = MIN(ZREC_SPLIT(*n), *kl);
const int n2 = *n - n1; const blasint n2 = *n - n1;
const int m1 = MIN(n1, *m); const blasint m1 = MIN(n1, *m);
const int m2 = *m - m1; const blasint m2 = *m - m1;
const int mn1 = MIN(m1, n1); const blasint mn1 = MIN(m1, n1);
const int mn2 = MIN(m2, n2); const blasint mn2 = MIN(m2, n2);
// Ab_L * // Ab_L *
// Ab_BR // Ab_BR
@ -129,14 +129,14 @@ static void RELAPACK_zgbtrf_rec(
// ipiv_T // ipiv_T
// ipiv_B // ipiv_B
int *const ipiv_T = ipiv; blasint *const ipiv_T = ipiv;
int *const ipiv_B = ipiv + n1; blasint *const ipiv_B = ipiv + n1;
// Banded splitting // Banded splitting
const int n21 = MIN(n2, kv - n1); const blasint n21 = MIN(n2, kv - n1);
const int n22 = MIN(n2 - n21, n1); const blasint n22 = MIN(n2 - n21, n1);
const int m21 = MIN(m2, *kl - m1); const blasint m21 = MIN(m2, *kl - m1);
const int m22 = MIN(m2 - m21, m1); const blasint m22 = MIN(m2 - m21, m1);
// n1 n21 n22 // n1 n21 n22
// m * A_Rl ARr // m * A_Rl ARr
@ -164,7 +164,7 @@ static void RELAPACK_zgbtrf_rec(
// partially redo swaps in A_L // partially redo swaps in A_L
for (i = 0; i < mn1; i++) { for (i = 0; i < mn1; i++) {
const int ip = ipiv_T[i] - 1; const blasint ip = ipiv_T[i] - 1;
if (ip != i) { if (ip != i) {
if (ip < *kl) if (ip < *kl)
BLAS(zswap)(&i, A_L + 2 * i, ldA, A_L + 2 * ip, ldA); BLAS(zswap)(&i, A_L + 2 * i, ldA, A_L + 2 * ip, ldA);
@ -180,7 +180,7 @@ static void RELAPACK_zgbtrf_rec(
for (j = 0; j < n22; j++) { for (j = 0; j < n22; j++) {
double *const A_Rrj = A_Rr + 2 * *ldA * j; double *const A_Rrj = A_Rr + 2 * *ldA * j;
for (i = j; i < mn1; i++) { for (i = j; i < mn1; i++) {
const int ip = ipiv_T[i] - 1; const blasint ip = ipiv_T[i] - 1;
if (ip != i) { if (ip != i) {
const double tmpr = A_Rrj[2 * i]; const double tmpr = A_Rrj[2 * i];
const double tmpc = A_Rrj[2 * i + 1]; const double tmpc = A_Rrj[2 * i + 1];
@ -211,7 +211,7 @@ static void RELAPACK_zgbtrf_rec(
// partially undo swaps in A_L // partially undo swaps in A_L
for (i = mn1 - 1; i >= 0; i--) { for (i = mn1 - 1; i >= 0; i--) {
const int ip = ipiv_T[i] - 1; const blasint ip = ipiv_T[i] - 1;
if (ip != i) { if (ip != i) {
if (ip < *kl) if (ip < *kl)
BLAS(zswap)(&i, A_L + 2 * i, ldA, A_L + 2 * ip, ldA); BLAS(zswap)(&i, A_L + 2 * i, ldA, A_L + 2 * ip, ldA);

66
relapack/src/zgemmt.c
View File

@ -1,12 +1,12 @@
#include "relapack.h" #include "relapack.h"
static void RELAPACK_zgemmt_rec(const char *, const char *, const char *, static void RELAPACK_zgemmt_rec(const char *, const char *, const char *,
const int *, const int *, const double *, const double *, const int *, const blasint *, const blasint *, const double *, const double *, const blasint *,
const double *, const int *, const double *, double *, const int *); const double *, const blasint *, const double *, double *, const blasint *);
static void RELAPACK_zgemmt_rec2(const char *, const char *, const char *, static void RELAPACK_zgemmt_rec2(const char *, const char *, const char *,
const int *, const int *, const double *, const double *, const int *, const blasint *, const blasint *, const double *, const double *, const blasint *,
const double *, const int *, const double *, double *, const int *); const double *, const blasint *, const double *, double *, const blasint *);
/** ZGEMMT computes a matrix-matrix product with general matrices but updates /** ZGEMMT computes a matrix-matrix product with general matrices but updates
@ -20,10 +20,10 @@ static void RELAPACK_zgemmt_rec2(const char *, const char *, const char *,
* */ * */
void RELAPACK_zgemmt( void RELAPACK_zgemmt(
const char *uplo, const char *transA, const char *transB, const char *uplo, const char *transA, const char *transB,
const int *n, const int *k, const blasint *n, const blasint *k,
const double *alpha, const double *A, const int *ldA, const double *alpha, const double *A, const blasint *ldA,
const double *B, const int *ldB, const double *B, const blasint *ldB,
const double *beta, double *C, const int *ldC const double *beta, double *C, const blasint *ldC
) { ) {
#if HAVE_XGEMMT #if HAVE_XGEMMT
@ -32,15 +32,15 @@ void RELAPACK_zgemmt(
#else #else
// Check arguments // Check arguments
const int lower = LAPACK(lsame)(uplo, "L"); const blasint lower = LAPACK(lsame)(uplo, "L");
const int upper = LAPACK(lsame)(uplo, "U"); const blasint upper = LAPACK(lsame)(uplo, "U");
const int notransA = LAPACK(lsame)(transA, "N"); const blasint notransA = LAPACK(lsame)(transA, "N");
const int tranA = LAPACK(lsame)(transA, "T"); const blasint tranA = LAPACK(lsame)(transA, "T");
const int ctransA = LAPACK(lsame)(transA, "C"); const blasint ctransA = LAPACK(lsame)(transA, "C");
const int notransB = LAPACK(lsame)(transB, "N"); const blasint notransB = LAPACK(lsame)(transB, "N");
const int tranB = LAPACK(lsame)(transB, "T"); const blasint tranB = LAPACK(lsame)(transB, "T");
const int ctransB = LAPACK(lsame)(transB, "C"); const blasint ctransB = LAPACK(lsame)(transB, "C");
int info = 0; blasint info = 0;
if (!lower && !upper) if (!lower && !upper)
info = 1; info = 1;
else if (!tranA && !ctransA && !notransA) else if (!tranA && !ctransA && !notransA)
@ -58,7 +58,7 @@ void RELAPACK_zgemmt(
else if (*ldC < MAX(1, *n)) else if (*ldC < MAX(1, *n))
info = 13; info = 13;
if (info) { if (info) {
LAPACK(xerbla)("ZGEMMT", &info); LAPACK(xerbla)("ZGEMMT", &info, strlen("ZGEMMT"));
return; return;
} }
@ -76,10 +76,10 @@ void RELAPACK_zgemmt(
/** zgemmt's recursive compute kernel */ /** zgemmt's recursive compute kernel */
static void RELAPACK_zgemmt_rec( static void RELAPACK_zgemmt_rec(
const char *uplo, const char *transA, const char *transB, const char *uplo, const char *transA, const char *transB,
const int *n, const int *k, const blasint *n, const blasint *k,
const double *alpha, const double *A, const int *ldA, const double *alpha, const double *A, const blasint *ldA,
const double *B, const int *ldB, const double *B, const blasint *ldB,
const double *beta, double *C, const int *ldC const double *beta, double *C, const blasint *ldC
) { ) {
if (*n <= MAX(CROSSOVER_ZGEMMT, 1)) { if (*n <= MAX(CROSSOVER_ZGEMMT, 1)) {
@ -89,8 +89,8 @@ static void RELAPACK_zgemmt_rec(
} }
// Splitting // Splitting
const int n1 = ZREC_SPLIT(*n); const blasint n1 = ZREC_SPLIT(*n);
const int n2 = *n - n1; const blasint n2 = *n - n1;
// A_T // A_T
// A_B // A_B
@ -126,16 +126,16 @@ static void RELAPACK_zgemmt_rec(
/** zgemmt's unblocked compute kernel */ /** zgemmt's unblocked compute kernel */
static void RELAPACK_zgemmt_rec2( static void RELAPACK_zgemmt_rec2(
const char *uplo, const char *transA, const char *transB, const char *uplo, const char *transA, const char *transB,
const int *n, const int *k, const blasint *n, const blasint *k,
const double *alpha, const double *A, const int *ldA, const double *alpha, const double *A, const blasint *ldA,
const double *B, const int *ldB, const double *B, const blasint *ldB,
const double *beta, double *C, const int *ldC const double *beta, double *C, const blasint *ldC
) { ) {
const int incB = (*transB == 'N') ? 1 : *ldB; const blasint incB = (*transB == 'N') ? 1 : *ldB;
const int incC = 1; const blasint incC = 1;
int i; blasint i;
for (i = 0; i < *n; i++) { for (i = 0; i < *n; i++) {
// A_0 // A_0
// A_i // A_i
@ -151,13 +151,13 @@ static void RELAPACK_zgemmt_rec2(
double *const C_ii = C + 2 * *ldC * i + 2 * i; double *const C_ii = C + 2 * *ldC * i + 2 * i;
if (*uplo == 'L') { if (*uplo == 'L') {
const int nmi = *n - i; const blasint nmi = *n - i;
if (*transA == 'N') if (*transA == 'N')
BLAS(zgemv)(transA, &nmi, k, alpha, A_i, ldA, B_i, &incB, beta, C_ii, &incC); BLAS(zgemv)(transA, &nmi, k, alpha, A_i, ldA, B_i, &incB, beta, C_ii, &incC);
else else
BLAS(zgemv)(transA, k, &nmi, alpha, A_i, ldA, B_i, &incB, beta, C_ii, &incC); BLAS(zgemv)(transA, k, &nmi, alpha, A_i, ldA, B_i, &incB, beta, C_ii, &incC);
} else { } else {
const int ip1 = i + 1; const blasint ip1 = i + 1;
if (*transA == 'N') if (*transA == 'N')
BLAS(zgemv)(transA, &ip1, k, alpha, A_0, ldA, B_i, &incB, beta, C_0i, &incC); BLAS(zgemv)(transA, &ip1, k, alpha, A_0, ldA, B_i, &incB, beta, C_0i, &incC);
else else

40
relapack/src/zgetrf.c
View File

@ -1,7 +1,7 @@
#include "relapack.h" #include "relapack.h"
static void RELAPACK_zgetrf_rec(const int *, const int *, double *, static void RELAPACK_zgetrf_rec(const blasint *, const blasint *, double *,
const int *, int *, int *); const blasint *, blasint *, blasint *);
/** ZGETRF computes an LU factorization of a general M-by-N matrix A using partial pivoting with row interchanges. /** ZGETRF computes an LU factorization of a general M-by-N matrix A using partial pivoting with row interchanges.
@ -11,9 +11,9 @@ static void RELAPACK_zgetrf_rec(const int *, const int *, double *,
* http://www.netlib.org/lapack/explore-html/dd/dd1/zgetrf_8f.html * http://www.netlib.org/lapack/explore-html/dd/dd1/zgetrf_8f.html
* */ * */
void RELAPACK_zgetrf( void RELAPACK_zgetrf(
const int *m, const int *n, const blasint *m, const blasint *n,
double *A, const int *ldA, int *ipiv, double *A, const blasint *ldA, blasint *ipiv,
int *info blasint *info
) { ) {
// Check arguments // Check arguments
@ -25,12 +25,12 @@ void RELAPACK_zgetrf(
else if (*ldA < MAX(1, *n)) else if (*ldA < MAX(1, *n))
*info = -4; *info = -4;
if (*info) { if (*info) {
const int minfo = -*info; const blasint minfo = -*info;
LAPACK(xerbla)("ZGETRF", &minfo); LAPACK(xerbla)("ZGETRF", &minfo, strlen("ZGETRF"));
return; return;
} }
const int sn = MIN(*m, *n); const blasint sn = MIN(*m, *n);
RELAPACK_zgetrf_rec(m, &sn, A, ldA, ipiv, info); RELAPACK_zgetrf_rec(m, &sn, A, ldA, ipiv, info);
@ -38,10 +38,10 @@ void RELAPACK_zgetrf(
if (*m < *n) { if (*m < *n) {
// Constants // Constants
const double ONE[] = { 1., 0. }; const double ONE[] = { 1., 0. };
const int iONE[] = { 1 }; const blasint iONE[] = { 1 };
// Splitting // Splitting
const int rn = *n - *m; const blasint rn = *n - *m;
// A_L A_R // A_L A_R
const double *const A_L = A; const double *const A_L = A;
@ -57,9 +57,9 @@ void RELAPACK_zgetrf(
/** zgetrf's recursive compute kernel */ /** zgetrf's recursive compute kernel */
static void RELAPACK_zgetrf_rec( static void RELAPACK_zgetrf_rec(
const int *m, const int *n, const blasint *m, const blasint *n,
double *A, const int *ldA, int *ipiv, double *A, const blasint *ldA, blasint *ipiv,
int *info blasint *info
) { ) {
if (*n <= MAX(CROSSOVER_ZGETRF, 1)) { if (*n <= MAX(CROSSOVER_ZGETRF, 1)) {
@ -71,12 +71,12 @@ static void RELAPACK_zgetrf_rec(
// Constants // Constants
const double ONE[] = { 1., 0. }; const double ONE[] = { 1., 0. };
const double MONE[] = { -1., 0. }; const double MONE[] = { -1., 0. };
const int iONE[] = { 1. }; const blasint iONE[] = { 1. };
// Splitting // Splitting
const int n1 = ZREC_SPLIT(*n); const blasint n1 = ZREC_SPLIT(*n);
const int n2 = *n - n1; const blasint n2 = *n - n1;
const int m2 = *m - n1; const blasint m2 = *m - n1;
// A_L A_R // A_L A_R
double *const A_L = A; double *const A_L = A;
@ -91,8 +91,8 @@ static void RELAPACK_zgetrf_rec(
// ipiv_T // ipiv_T
// ipiv_B // ipiv_B
int *const ipiv_T = ipiv; blasint *const ipiv_T = ipiv;
int *const ipiv_B = ipiv + n1; blasint *const ipiv_B = ipiv + n1;
// recursion(A_L, ipiv_T) // recursion(A_L, ipiv_T)
RELAPACK_zgetrf_rec(m, &n1, A_L, ldA, ipiv_T, info); RELAPACK_zgetrf_rec(m, &n1, A_L, ldA, ipiv_T, info);
@ -111,7 +111,7 @@ static void RELAPACK_zgetrf_rec(
// apply pivots to A_BL // apply pivots to A_BL
LAPACK(zlaswp)(&n1, A_BL, ldA, iONE, &n2, ipiv_B, iONE); LAPACK(zlaswp)(&n1, A_BL, ldA, iONE, &n2, ipiv_B, iONE);
// shift pivots // shift pivots
int i; blasint i;
for (i = 0; i < n2; i++) for (i = 0; i < n2; i++)
ipiv_B[i] += n1; ipiv_B[i] += n1;
} }

38
relapack/src/zhegst.c
View File

@ -3,9 +3,9 @@
#include "stdlib.h" #include "stdlib.h"
#endif #endif
static void RELAPACK_zhegst_rec(const int *, const char *, const int *, static void RELAPACK_zhegst_rec(const blasint *, const char *, const blasint *,
double *, const int *, const double *, const int *, double *, const blasint *, const double *, const blasint *,
double *, const int *, int *); double *, const blasint *, blasint *);
/** ZHEGST reduces a complex Hermitian-definite generalized eigenproblem to standard form. /** ZHEGST reduces a complex Hermitian-definite generalized eigenproblem to standard form.
@ -15,14 +15,14 @@ static void RELAPACK_zhegst_rec(const int *, const char *, const int *,
* http://www.netlib.org/lapack/explore-html/dc/d68/zhegst_8f.html * http://www.netlib.org/lapack/explore-html/dc/d68/zhegst_8f.html
* */ * */
void RELAPACK_zhegst( void RELAPACK_zhegst(
const int *itype, const char *uplo, const int *n, const blasint *itype, const char *uplo, const blasint *n,
double *A, const int *ldA, const double *B, const int *ldB, double *A, const blasint *ldA, const double *B, const blasint *ldB,
int *info blasint *info
) { ) {
// Check arguments // Check arguments
const int lower = LAPACK(lsame)(uplo, "L"); const blasint lower = LAPACK(lsame)(uplo, "L");
const int upper = LAPACK(lsame)(uplo, "U"); const blasint upper = LAPACK(lsame)(uplo, "U");
*info = 0; *info = 0;
if (*itype < 1 || *itype > 3) if (*itype < 1 || *itype > 3)
*info = -1; *info = -1;
@ -35,8 +35,8 @@ void RELAPACK_zhegst(
else if (*ldB < MAX(1, *n)) else if (*ldB < MAX(1, *n))
*info = -7; *info = -7;
if (*info) { if (*info) {
const int minfo = -*info; const blasint minfo = -*info;
LAPACK(xerbla)("ZHEGST", &minfo); LAPACK(xerbla)("ZHEGST", &minfo, strlen("ZHEGST"));
return; return;
} }
@ -45,9 +45,9 @@ void RELAPACK_zhegst(
// Allocate work space // Allocate work space
double *Work = NULL; double *Work = NULL;
int lWork = 0; blasint lWork = 0;
#if XSYGST_ALLOW_MALLOC #if XSYGST_ALLOW_MALLOC
const int n1 = ZREC_SPLIT(*n); const blasint n1 = ZREC_SPLIT(*n);
lWork = n1 * (*n - n1); lWork = n1 * (*n - n1);
Work = malloc(lWork * 2 * sizeof(double)); Work = malloc(lWork * 2 * sizeof(double));
if (!Work) if (!Work)
@ -67,9 +67,9 @@ void RELAPACK_zhegst(
/** zhegst's recursive compute kernel */ /** zhegst's recursive compute kernel */
static void RELAPACK_zhegst_rec( static void RELAPACK_zhegst_rec(
const int *itype, const char *uplo, const int *n, const blasint *itype, const char *uplo, const blasint *n,
double *A, const int *ldA, const double *B, const int *ldB, double *A, const blasint *ldA, const double *B, const blasint *ldB,
double *Work, const int *lWork, int *info double *Work, const blasint *lWork, blasint *info
) { ) {
if (*n <= MAX(CROSSOVER_ZHEGST, 1)) { if (*n <= MAX(CROSSOVER_ZHEGST, 1)) {
@ -84,14 +84,14 @@ static void RELAPACK_zhegst_rec(
const double MONE[] = { -1., 0. }; const double MONE[] = { -1., 0. };
const double HALF[] = { .5, 0. }; const double HALF[] = { .5, 0. };
const double MHALF[] = { -.5, 0. }; const double MHALF[] = { -.5, 0. };
const int iONE[] = { 1 }; const blasint iONE[] = { 1 };
// Loop iterator // Loop iterator
int i; blasint i;
// Splitting // Splitting
const int n1 = ZREC_SPLIT(*n); const blasint n1 = ZREC_SPLIT(*n);
const int n2 = *n - n1; const blasint n2 = *n - n1;
// A_TL A_TR // A_TL A_TR
// A_BL A_BR // A_BL A_BR

72
relapack/src/zhetrf.c
View File

@ -3,8 +3,8 @@
#include <stdlib.h> #include <stdlib.h>
#endif #endif
static void RELAPACK_zhetrf_rec(const char *, const int *, const int *, int *, static void RELAPACK_zhetrf_rec(const char *, const blasint *, const blasint *, blasint *,
double *, const int *, int *, double *, const int *, int *); double *, const blasint *, blasint *, double *, const blasint *, blasint *);
/** ZHETRF computes the factorization of a complex Hermitian matrix A using the Bunch-Kaufman diagonal pivoting method. /** ZHETRF computes the factorization of a complex Hermitian matrix A using the Bunch-Kaufman diagonal pivoting method.
@ -14,21 +14,21 @@ static void RELAPACK_zhetrf_rec(const char *, const int *, const int *, int *,
* http://www.netlib.org/lapack/explore-html/d6/dd3/zhetrf_8f.html * http://www.netlib.org/lapack/explore-html/d6/dd3/zhetrf_8f.html
* */ * */
void RELAPACK_zhetrf( void RELAPACK_zhetrf(
const char *uplo, const int *n, const char *uplo, const blasint *n,
double *A, const int *ldA, int *ipiv, double *A, const blasint *ldA, blasint *ipiv,
double *Work, const int *lWork, int *info double *Work, const blasint *lWork, blasint *info
) { ) {
// Required work size // Required work size
const int cleanlWork = *n * (*n / 2); const blasint cleanlWork = *n * (*n / 2);
int minlWork = cleanlWork; blasint minlWork = cleanlWork;
#if XSYTRF_ALLOW_MALLOC #if XSYTRF_ALLOW_MALLOC
minlWork = 1; minlWork = 1;
#endif #endif
// Check arguments // Check arguments
const int lower = LAPACK(lsame)(uplo, "L"); const blasint lower = LAPACK(lsame)(uplo, "L");
const int upper = LAPACK(lsame)(uplo, "U"); const blasint upper = LAPACK(lsame)(uplo, "U");
*info = 0; *info = 0;
if (!lower && !upper) if (!lower && !upper)
*info = -1; *info = -1;
@ -55,8 +55,8 @@ void RELAPACK_zhetrf(
#endif #endif
if (*info) { if (*info) {
const int minfo = -*info; const blasint minfo = -*info;
LAPACK(xerbla)("ZHETRF", &minfo); LAPACK(xerbla)("ZHETRF", &minfo, strlen("ZHETRF"));
return; return;
} }
@ -64,7 +64,7 @@ void RELAPACK_zhetrf(
const char cleanuplo = lower ? 'L' : 'U'; const char cleanuplo = lower ? 'L' : 'U';
// Dummy argument // Dummy argument
int nout; blasint nout;
// Recursive kernel // Recursive kernel
RELAPACK_zhetrf_rec(&cleanuplo, n, n, &nout, A, ldA, ipiv, cleanWork, n, info); RELAPACK_zhetrf_rec(&cleanuplo, n, n, &nout, A, ldA, ipiv, cleanWork, n, info);
@ -78,13 +78,13 @@ void RELAPACK_zhetrf(
/** zhetrf's recursive compute kernel */ /** zhetrf's recursive compute kernel */
static void RELAPACK_zhetrf_rec( static void RELAPACK_zhetrf_rec(
const char *uplo, const int *n_full, const int *n, int *n_out, const char *uplo, const blasint *n_full, const blasint *n, blasint *n_out,
double *A, const int *ldA, int *ipiv, double *A, const blasint *ldA, blasint *ipiv,
double *Work, const int *ldWork, int *info double *Work, const blasint *ldWork, blasint *info
) { ) {
// top recursion level? // top recursion level?
const int top = *n_full == *n; const blasint top = *n_full == *n;
if (*n <= MAX(CROSSOVER_ZHETRF, 3)) { if (*n <= MAX(CROSSOVER_ZHETRF, 3)) {
// Unblocked // Unblocked
@ -96,31 +96,31 @@ static void RELAPACK_zhetrf_rec(
return; return;
} }
int info1, info2; blasint info1, info2;
// Constants // Constants
const double ONE[] = { 1., 0. }; const double ONE[] = { 1., 0. };
const double MONE[] = { -1., 0. }; const double MONE[] = { -1., 0. };
const int iONE[] = { 1 }; const blasint iONE[] = { 1 };
const int n_rest = *n_full - *n; const blasint n_rest = *n_full - *n;
if (*uplo == 'L') { if (*uplo == 'L') {
// Splitting (setup) // Splitting (setup)
int n1 = ZREC_SPLIT(*n); blasint n1 = ZREC_SPLIT(*n);
int n2 = *n - n1; blasint n2 = *n - n1;
// Work_L * // Work_L *
double *const Work_L = Work; double *const Work_L = Work;
// recursion(A_L) // recursion(A_L)
int n1_out; blasint n1_out;
RELAPACK_zhetrf_rec(uplo, n_full, &n1, &n1_out, A, ldA, ipiv, Work_L, ldWork, &info1); RELAPACK_zhetrf_rec(uplo, n_full, &n1, &n1_out, A, ldA, ipiv, Work_L, ldWork, &info1);
n1 = n1_out; n1 = n1_out;
// Splitting (continued) // Splitting (continued)
n2 = *n - n1; n2 = *n - n1;
const int n_full2 = *n_full - n1; const blasint n_full2 = *n_full - n1;
// * * // * *
// A_BL A_BR // A_BL A_BR
@ -136,23 +136,23 @@ static void RELAPACK_zhetrf_rec(
// (top recursion level: use Work as Work_BR) // (top recursion level: use Work as Work_BR)
double *const Work_BL = Work + 2 * n1; double *const Work_BL = Work + 2 * n1;
double *const Work_BR = top ? Work : Work + 2 * *ldWork * n1 + 2 * n1; double *const Work_BR = top ? Work : Work + 2 * *ldWork * n1 + 2 * n1;
const int ldWork_BR = top ? n2 : *ldWork; const blasint ldWork_BR = top ? n2 : *ldWork;
// ipiv_T // ipiv_T
// ipiv_B // ipiv_B
int *const ipiv_B = ipiv + n1; blasint *const ipiv_B = ipiv + n1;
// A_BR = A_BR - A_BL Work_BL' // A_BR = A_BR - A_BL Work_BL'
RELAPACK_zgemmt(uplo, "N", "T", &n2, &n1, MONE, A_BL, ldA, Work_BL, ldWork, ONE, A_BR, ldA); RELAPACK_zgemmt(uplo, "N", "T", &n2, &n1, MONE, A_BL, ldA, Work_BL, ldWork, ONE, A_BR, ldA);
BLAS(zgemm)("N", "T", &n_rest, &n2, &n1, MONE, A_BL_B, ldA, Work_BL, ldWork, ONE, A_BR_B, ldA); BLAS(zgemm)("N", "T", &n_rest, &n2, &n1, MONE, A_BL_B, ldA, Work_BL, ldWork, ONE, A_BR_B, ldA);
// recursion(A_BR) // recursion(A_BR)
int n2_out; blasint n2_out;
RELAPACK_zhetrf_rec(uplo, &n_full2, &n2, &n2_out, A_BR, ldA, ipiv_B, Work_BR, &ldWork_BR, &info2); RELAPACK_zhetrf_rec(uplo, &n_full2, &n2, &n2_out, A_BR, ldA, ipiv_B, Work_BR, &ldWork_BR, &info2);
if (n2_out != n2) { if (n2_out != n2) {
// undo 1 column of updates // undo 1 column of updates
const int n_restp1 = n_rest + 1; const blasint n_restp1 = n_rest + 1;
// last column of A_BR // last column of A_BR
double *const A_BR_r = A_BR + 2 * *ldA * n2_out + 2 * n2_out; double *const A_BR_r = A_BR + 2 * *ldA * n2_out + 2 * n2_out;
@ -169,7 +169,7 @@ static void RELAPACK_zhetrf_rec(
n2 = n2_out; n2 = n2_out;
// shift pivots // shift pivots
int i; blasint i;
for (i = 0; i < n2; i++) for (i = 0; i < n2; i++)
if (ipiv_B[i] > 0) if (ipiv_B[i] > 0)
ipiv_B[i] += n1; ipiv_B[i] += n1;
@ -180,22 +180,22 @@ static void RELAPACK_zhetrf_rec(
*n_out = n1 + n2; *n_out = n1 + n2;
} else { } else {
// Splitting (setup) // Splitting (setup)
int n2 = ZREC_SPLIT(*n); blasint n2 = ZREC_SPLIT(*n);
int n1 = *n - n2; blasint n1 = *n - n2;
// * Work_R // * Work_R
// (top recursion level: use Work as Work_R) // (top recursion level: use Work as Work_R)
double *const Work_R = top ? Work : Work + 2 * *ldWork * n1; double *const Work_R = top ? Work : Work + 2 * *ldWork * n1;
// recursion(A_R) // recursion(A_R)
int n2_out; blasint n2_out;
RELAPACK_zhetrf_rec(uplo, n_full, &n2, &n2_out, A, ldA, ipiv, Work_R, ldWork, &info2); RELAPACK_zhetrf_rec(uplo, n_full, &n2, &n2_out, A, ldA, ipiv, Work_R, ldWork, &info2);
const int n2_diff = n2 - n2_out; const blasint n2_diff = n2 - n2_out;
n2 = n2_out; n2 = n2_out;
// Splitting (continued) // Splitting (continued)
n1 = *n - n2; n1 = *n - n2;
const int n_full1 = *n_full - n2; const blasint n_full1 = *n_full - n2;
// * A_TL_T A_TR_T // * A_TL_T A_TR_T
// * A_TL A_TR // * A_TL A_TR
@ -211,19 +211,19 @@ static void RELAPACK_zhetrf_rec(
// (top recursion level: Work_R was Work) // (top recursion level: Work_R was Work)
double *const Work_L = Work; double *const Work_L = Work;
double *const Work_TR = Work + 2 * *ldWork * (top ? n2_diff : n1) + 2 * n_rest; double *const Work_TR = Work + 2 * *ldWork * (top ? n2_diff : n1) + 2 * n_rest;
const int ldWork_L = top ? n1 : *ldWork; const blasint ldWork_L = top ? n1 : *ldWork;
// A_TL = A_TL - A_TR Work_TR' // A_TL = A_TL - A_TR Work_TR'
RELAPACK_zgemmt(uplo, "N", "T", &n1, &n2, MONE, A_TR, ldA, Work_TR, ldWork, ONE, A_TL, ldA); RELAPACK_zgemmt(uplo, "N", "T", &n1, &n2, MONE, A_TR, ldA, Work_TR, ldWork, ONE, A_TL, ldA);
BLAS(zgemm)("N", "T", &n_rest, &n1, &n2, MONE, A_TR_T, ldA, Work_TR, ldWork, ONE, A_TL_T, ldA); BLAS(zgemm)("N", "T", &n_rest, &n1, &n2, MONE, A_TR_T, ldA, Work_TR, ldWork, ONE, A_TL_T, ldA);
// recursion(A_TL) // recursion(A_TL)
int n1_out; blasint n1_out;
RELAPACK_zhetrf_rec(uplo, &n_full1, &n1, &n1_out, A, ldA, ipiv, Work_L, &ldWork_L, &info1); RELAPACK_zhetrf_rec(uplo, &n_full1, &n1, &n1_out, A, ldA, ipiv, Work_L, &ldWork_L, &info1);
if (n1_out != n1) { if (n1_out != n1) {
// undo 1 column of updates // undo 1 column of updates
const int n_restp1 = n_rest + 1; const blasint n_restp1 = n_rest + 1;
// A_TL_T_l = A_TL_T_l + A_TR_T Work_TR_t' // A_TL_T_l = A_TL_T_l + A_TR_T Work_TR_t'
BLAS(zgemv)("N", &n_restp1, &n2, ONE, A_TR_T, ldA, Work_TR, ldWork, ONE, A_TL_T, iONE); BLAS(zgemv)("N", &n_restp1, &n2, ONE, A_TR_T, ldA, Work_TR, ldWork, ONE, A_TL_T, iONE);

36
relapack/src/zhetrf_rec2.c
View File

@ -15,7 +15,7 @@
/* Table of constant values */ /* Table of constant values */
static doublecomplex c_b1 = {1.,0.}; static doublecomplex c_b1 = {1.,0.};
static int c__1 = 1; static blasint c__1 = 1;
/** ZHETRF_REC2 computes a partial factorization of a complex Hermitian indefinite matrix using the Bunch-Kau fman diagonal pivoting method /** ZHETRF_REC2 computes a partial factorization of a complex Hermitian indefinite matrix using the Bunch-Kau fman diagonal pivoting method
* *
@ -24,12 +24,12 @@ static int c__1 = 1;
* The blocked BLAS Level 3 updates were removed and moved to the * The blocked BLAS Level 3 updates were removed and moved to the
* recursive algorithm. * recursive algorithm.
* */ * */
/* Subroutine */ void RELAPACK_zhetrf_rec2(char *uplo, int *n, int * /* Subroutine */ void RELAPACK_zhetrf_rec2(char *uplo, blasint *n, blasint *
nb, int *kb, doublecomplex *a, int *lda, int *ipiv, nb, blasint *kb, doublecomplex *a, blasint *lda, blasint *ipiv,
doublecomplex *w, int *ldw, int *info, ftnlen uplo_len) doublecomplex *w, blasint *ldw, blasint *info, ftnlen uplo_len)
{ {
/* System generated locals */ /* System generated locals */
int a_dim1, a_offset, w_dim1, w_offset, i__1, i__2, i__3, i__4; blasint a_dim1, a_offset, w_dim1, w_offset, i__1, i__2, i__3, i__4;
double d__1, d__2, d__3, d__4; double d__1, d__2, d__3, d__4;
doublecomplex z__1, z__2, z__3, z__4; doublecomplex z__1, z__2, z__3, z__4;
@ -39,26 +39,26 @@ static int c__1 = 1;
doublecomplex *, doublecomplex *); doublecomplex *, doublecomplex *);
/* Local variables */ /* Local variables */
static int j, k; static blasint j, k;
static double t, r1; static double t, r1;
static doublecomplex d11, d21, d22; static doublecomplex d11, d21, d22;
static int jj, kk, jp, kp, kw, kkw, imax, jmax; static blasint jj, kk, jp, kp, kw, kkw, imax, jmax;
static double alpha; static double alpha;
extern logical lsame_(char *, char *, ftnlen, ftnlen); extern logical lsame_(char *, char *, ftnlen, ftnlen);
static int kstep; static blasint kstep;
extern /* Subroutine */ int zgemv_(char *, int *, int *, extern /* Subroutine */ blasint zgemv_(char *, blasint *, blasint *,
doublecomplex *, doublecomplex *, int *, doublecomplex *, doublecomplex *, doublecomplex *, blasint *, doublecomplex *,
int *, doublecomplex *, doublecomplex *, int *, ftnlen), blasint *, doublecomplex *, doublecomplex *, blasint *, ftnlen),
zcopy_(int *, doublecomplex *, int *, doublecomplex *, zcopy_(int *, doublecomplex *, blasint *, doublecomplex *,
int *), zswap_(int *, doublecomplex *, int *, blasint *), zswap_(int *, doublecomplex *, blasint *,
doublecomplex *, int *); doublecomplex *, blasint *);
static double absakk; static double absakk;
extern /* Subroutine */ int zdscal_(int *, double *, extern /* Subroutine */ blasint zdscal_(int *, double *,
doublecomplex *, int *); doublecomplex *, blasint *);
static double colmax; static double colmax;
extern /* Subroutine */ int zlacgv_(int *, doublecomplex *, int *) extern /* Subroutine */ blasint zlacgv_(int *, doublecomplex *, blasint *)
; ;
extern int izamax_(int *, doublecomplex *, int *); extern blasint izamax_(int *, doublecomplex *, blasint *);
static double rowmax; static double rowmax;
/* Parameter adjustments */ /* Parameter adjustments */

72
relapack/src/zhetrf_rook.c
View File

@ -3,8 +3,8 @@
#include <stdlib.h> #include <stdlib.h>
#endif #endif
static void RELAPACK_zhetrf_rook_rec(const char *, const int *, const int *, int *, static void RELAPACK_zhetrf_rook_rec(const char *, const blasint *, const blasint *, blasint *,
double *, const int *, int *, double *, const int *, int *); double *, const blasint *, blasint *, double *, const blasint *, blasint *);
/** ZHETRF_ROOK computes the factorization of a complex Hermitian indefinite matrix using the bounded Bunch-Kaufman ("rook") diagonal pivoting method. /** ZHETRF_ROOK computes the factorization of a complex Hermitian indefinite matrix using the bounded Bunch-Kaufman ("rook") diagonal pivoting method.
@ -14,21 +14,21 @@ static void RELAPACK_zhetrf_rook_rec(const char *, const int *, const int *, int
* http://www.netlib.org/lapack/explore-html/d6/d6f/zhetrf__rook_8f.html * http://www.netlib.org/lapack/explore-html/d6/d6f/zhetrf__rook_8f.html
* */ * */
void RELAPACK_zhetrf_rook( void RELAPACK_zhetrf_rook(
const char *uplo, const int *n, const char *uplo, const blasint *n,
double *A, const int *ldA, int *ipiv, double *A, const blasint *ldA, blasint *ipiv,
double *Work, const int *lWork, int *info double *Work, const blasint *lWork, blasint *info
) { ) {
// Required work size // Required work size
const int cleanlWork = *n * (*n / 2); const blasint cleanlWork = *n * (*n / 2);
int minlWork = cleanlWork; blasint minlWork = cleanlWork;
#if XSYTRF_ALLOW_MALLOC #if XSYTRF_ALLOW_MALLOC
minlWork = 1; minlWork = 1;
#endif #endif
// Check arguments // Check arguments
const int lower = LAPACK(lsame)(uplo, "L"); const blasint lower = LAPACK(lsame)(uplo, "L");
const int upper = LAPACK(lsame)(uplo, "U"); const blasint upper = LAPACK(lsame)(uplo, "U");
*info = 0; *info = 0;
if (!lower && !upper) if (!lower && !upper)
*info = -1; *info = -1;
@ -55,8 +55,8 @@ void RELAPACK_zhetrf_rook(
#endif #endif
if (*info) { if (*info) {
const int minfo = -*info; const blasint minfo = -*info;
LAPACK(xerbla)("ZHETRF", &minfo); LAPACK(xerbla)("ZHETRF", &minfo, strlen("ZHETRF"));
return; return;
} }
@ -64,7 +64,7 @@ void RELAPACK_zhetrf_rook(
const char cleanuplo = lower ? 'L' : 'U'; const char cleanuplo = lower ? 'L' : 'U';
// Dummy argument // Dummy argument
int nout; blasint nout;
// Recursive kernel // Recursive kernel
RELAPACK_zhetrf_rook_rec(&cleanuplo, n, n, &nout, A, ldA, ipiv, cleanWork, n, info); RELAPACK_zhetrf_rook_rec(&cleanuplo, n, n, &nout, A, ldA, ipiv, cleanWork, n, info);
@ -78,13 +78,13 @@ void RELAPACK_zhetrf_rook(
/** zhetrf_rook's recursive compute kernel */ /** zhetrf_rook's recursive compute kernel */
static void RELAPACK_zhetrf_rook_rec( static void RELAPACK_zhetrf_rook_rec(
const char *uplo, const int *n_full, const int *n, int *n_out, const char *uplo, const blasint *n_full, const blasint *n, blasint *n_out,
double *A, const int *ldA, int *ipiv, double *A, const blasint *ldA, blasint *ipiv,
double *Work, const int *ldWork, int *info double *Work, const blasint *ldWork, blasint *info
) { ) {
// top recursion level? // top recursion level?
const int top = *n_full == *n; const blasint top = *n_full == *n;
if (*n <= MAX(CROSSOVER_ZHETRF_ROOK, 3)) { if (*n <= MAX(CROSSOVER_ZHETRF_ROOK, 3)) {
// Unblocked // Unblocked
@ -96,31 +96,31 @@ static void RELAPACK_zhetrf_rook_rec(
return; return;
} }
int info1, info2; blasint info1, info2;
// Constants // Constants
const double ONE[] = { 1., 0. }; const double ONE[] = { 1., 0. };
const double MONE[] = { -1., 0. }; const double MONE[] = { -1., 0. };
const int iONE[] = { 1 }; const blasint iONE[] = { 1 };
const int n_rest = *n_full - *n; const blasint n_rest = *n_full - *n;
if (*uplo == 'L') { if (*uplo == 'L') {
// Splitting (setup) // Splitting (setup)
int n1 = ZREC_SPLIT(*n); blasint n1 = ZREC_SPLIT(*n);
int n2 = *n - n1; blasint n2 = *n - n1;
// Work_L * // Work_L *
double *const Work_L = Work; double *const Work_L = Work;
// recursion(A_L) // recursion(A_L)
int n1_out; blasint n1_out;
RELAPACK_zhetrf_rook_rec(uplo, n_full, &n1, &n1_out, A, ldA, ipiv, Work_L, ldWork, &info1); RELAPACK_zhetrf_rook_rec(uplo, n_full, &n1, &n1_out, A, ldA, ipiv, Work_L, ldWork, &info1);
n1 = n1_out; n1 = n1_out;
// Splitting (continued) // Splitting (continued)
n2 = *n - n1; n2 = *n - n1;
const int n_full2 = *n_full - n1; const blasint n_full2 = *n_full - n1;
// * * // * *
// A_BL A_BR // A_BL A_BR
@ -136,23 +136,23 @@ static void RELAPACK_zhetrf_rook_rec(
// (top recursion level: use Work as Work_BR) // (top recursion level: use Work as Work_BR)
double *const Work_BL = Work + 2 * n1; double *const Work_BL = Work + 2 * n1;
double *const Work_BR = top ? Work : Work + 2 * *ldWork * n1 + 2 * n1; double *const Work_BR = top ? Work : Work + 2 * *ldWork * n1 + 2 * n1;
const int ldWork_BR = top ? n2 : *ldWork; const blasint ldWork_BR = top ? n2 : *ldWork;
// ipiv_T // ipiv_T
// ipiv_B // ipiv_B
int *const ipiv_B = ipiv + n1; blasint *const ipiv_B = ipiv + n1;
// A_BR = A_BR - A_BL Work_BL' // A_BR = A_BR - A_BL Work_BL'
RELAPACK_zgemmt(uplo, "N", "T", &n2, &n1, MONE, A_BL, ldA, Work_BL, ldWork, ONE, A_BR, ldA); RELAPACK_zgemmt(uplo, "N", "T", &n2, &n1, MONE, A_BL, ldA, Work_BL, ldWork, ONE, A_BR, ldA);
BLAS(zgemm)("N", "T", &n_rest, &n2, &n1, MONE, A_BL_B, ldA, Work_BL, ldWork, ONE, A_BR_B, ldA); BLAS(zgemm)("N", "T", &n_rest, &n2, &n1, MONE, A_BL_B, ldA, Work_BL, ldWork, ONE, A_BR_B, ldA);
// recursion(A_BR) // recursion(A_BR)
int n2_out; blasint n2_out;
RELAPACK_zhetrf_rook_rec(uplo, &n_full2, &n2, &n2_out, A_BR, ldA, ipiv_B, Work_BR, &ldWork_BR, &info2); RELAPACK_zhetrf_rook_rec(uplo, &n_full2, &n2, &n2_out, A_BR, ldA, ipiv_B, Work_BR, &ldWork_BR, &info2);
if (n2_out != n2) { if (n2_out != n2) {
// undo 1 column of updates // undo 1 column of updates
const int n_restp1 = n_rest + 1; const blasint n_restp1 = n_rest + 1;
// last column of A_BR // last column of A_BR
double *const A_BR_r = A_BR + 2 * *ldA * n2_out + 2 * n2_out; double *const A_BR_r = A_BR + 2 * *ldA * n2_out + 2 * n2_out;
@ -169,7 +169,7 @@ static void RELAPACK_zhetrf_rook_rec(
n2 = n2_out; n2 = n2_out;
// shift pivots // shift pivots
int i; blasint i;
for (i = 0; i < n2; i++) for (i = 0; i < n2; i++)
if (ipiv_B[i] > 0) if (ipiv_B[i] > 0)
ipiv_B[i] += n1; ipiv_B[i] += n1;
@ -180,22 +180,22 @@ static void RELAPACK_zhetrf_rook_rec(
*n_out = n1 + n2; *n_out = n1 + n2;
} else { } else {
// Splitting (setup) // Splitting (setup)
int n2 = ZREC_SPLIT(*n); blasint n2 = ZREC_SPLIT(*n);
int n1 = *n - n2; blasint n1 = *n - n2;
// * Work_R // * Work_R
// (top recursion level: use Work as Work_R) // (top recursion level: use Work as Work_R)
double *const Work_R = top ? Work : Work + 2 * *ldWork * n1; double *const Work_R = top ? Work : Work + 2 * *ldWork * n1;
// recursion(A_R) // recursion(A_R)
int n2_out; blasint n2_out;
RELAPACK_zhetrf_rook_rec(uplo, n_full, &n2, &n2_out, A, ldA, ipiv, Work_R, ldWork, &info2); RELAPACK_zhetrf_rook_rec(uplo, n_full, &n2, &n2_out, A, ldA, ipiv, Work_R, ldWork, &info2);
const int n2_diff = n2 - n2_out; const blasint n2_diff = n2 - n2_out;
n2 = n2_out; n2 = n2_out;
// Splitting (continued) // Splitting (continued)
n1 = *n - n2; n1 = *n - n2;
const int n_full1 = *n_full - n2; const blasint n_full1 = *n_full - n2;
// * A_TL_T A_TR_T // * A_TL_T A_TR_T
// * A_TL A_TR // * A_TL A_TR
@ -211,19 +211,19 @@ static void RELAPACK_zhetrf_rook_rec(
// (top recursion level: Work_R was Work) // (top recursion level: Work_R was Work)
double *const Work_L = Work; double *const Work_L = Work;
double *const Work_TR = Work + 2 * *ldWork * (top ? n2_diff : n1) + 2 * n_rest; double *const Work_TR = Work + 2 * *ldWork * (top ? n2_diff : n1) + 2 * n_rest;
const int ldWork_L = top ? n1 : *ldWork; const blasint ldWork_L = top ? n1 : *ldWork;
// A_TL = A_TL - A_TR Work_TR' // A_TL = A_TL - A_TR Work_TR'
RELAPACK_zgemmt(uplo, "N", "T", &n1, &n2, MONE, A_TR, ldA, Work_TR, ldWork, ONE, A_TL, ldA); RELAPACK_zgemmt(uplo, "N", "T", &n1, &n2, MONE, A_TR, ldA, Work_TR, ldWork, ONE, A_TL, ldA);
BLAS(zgemm)("N", "T", &n_rest, &n1, &n2, MONE, A_TR_T, ldA, Work_TR, ldWork, ONE, A_TL_T, ldA); BLAS(zgemm)("N", "T", &n_rest, &n1, &n2, MONE, A_TR_T, ldA, Work_TR, ldWork, ONE, A_TL_T, ldA);
// recursion(A_TL) // recursion(A_TL)
int n1_out; blasint n1_out;
RELAPACK_zhetrf_rook_rec(uplo, &n_full1, &n1, &n1_out, A, ldA, ipiv, Work_L, &ldWork_L, &info1); RELAPACK_zhetrf_rook_rec(uplo, &n_full1, &n1, &n1_out, A, ldA, ipiv, Work_L, &ldWork_L, &info1);
if (n1_out != n1) { if (n1_out != n1) {
// undo 1 column of updates // undo 1 column of updates
const int n_restp1 = n_rest + 1; const blasint n_restp1 = n_rest + 1;
// A_TL_T_l = A_TL_T_l + A_TR_T Work_TR_t' // A_TL_T_l = A_TL_T_l + A_TR_T Work_TR_t'
BLAS(zgemv)("N", &n_restp1, &n2, ONE, A_TR_T, ldA, Work_TR, ldWork, ONE, A_TL_T, iONE); BLAS(zgemv)("N", &n_restp1, &n2, ONE, A_TR_T, ldA, Work_TR, ldWork, ONE, A_TL_T, iONE);

38
relapack/src/zhetrf_rook_rec2.c
View File

@ -15,7 +15,7 @@
/* Table of constant values */ /* Table of constant values */
static doublecomplex c_b1 = {1.,0.}; static doublecomplex c_b1 = {1.,0.};
static int c__1 = 1; static blasint c__1 = 1;
/** ZHETRF_ROOK_REC2 computes a partial factorization of a complex Hermitian indefinite matrix using the boun ded Bunch-Kaufman ("rook") diagonal pivoting method /** ZHETRF_ROOK_REC2 computes a partial factorization of a complex Hermitian indefinite matrix using the boun ded Bunch-Kaufman ("rook") diagonal pivoting method
* *
@ -24,12 +24,12 @@ static int c__1 = 1;
* The blocked BLAS Level 3 updates were removed and moved to the * The blocked BLAS Level 3 updates were removed and moved to the
* recursive algorithm. * recursive algorithm.
* */ * */
/* Subroutine */ void RELAPACK_zhetrf_rook_rec2(char *uplo, int *n, /* Subroutine */ void RELAPACK_zhetrf_rook_rec2(char *uplo, blasint *n,
int *nb, int *kb, doublecomplex *a, int *lda, int * int *nb, blasint *kb, doublecomplex *a, blasint *lda, blasint *
ipiv, doublecomplex *w, int *ldw, int *info, ftnlen uplo_len) ipiv, doublecomplex *w, blasint *ldw, blasint *info, ftnlen uplo_len)
{ {
/* System generated locals */ /* System generated locals */
int a_dim1, a_offset, w_dim1, w_offset, i__1, i__2, i__3, i__4; blasint a_dim1, a_offset, w_dim1, w_offset, i__1, i__2, i__3, i__4;
double d__1, d__2; double d__1, d__2;
doublecomplex z__1, z__2, z__3, z__4, z__5; doublecomplex z__1, z__2, z__3, z__4, z__5;
@ -39,30 +39,30 @@ static int c__1 = 1;
doublecomplex *, doublecomplex *); doublecomplex *, doublecomplex *);
/* Local variables */ /* Local variables */
static int j, k, p; static blasint j, k, p;
static double t, r1; static double t, r1;
static doublecomplex d11, d21, d22; static doublecomplex d11, d21, d22;
static int ii, jj, kk, kp, kw, jp1, jp2, kkw; static blasint ii, jj, kk, kp, kw, jp1, jp2, kkw;
static logical done; static logical done;
static int imax, jmax; static blasint imax, jmax;
static double alpha; static double alpha;
extern logical lsame_(char *, char *, ftnlen, ftnlen); extern logical lsame_(char *, char *, ftnlen, ftnlen);
static double dtemp, sfmin; static double dtemp, sfmin;
static int itemp, kstep; static blasint itemp, kstep;
extern /* Subroutine */ int zgemv_(char *, int *, int *, extern /* Subroutine */ blasint zgemv_(char *, blasint *, blasint *,
doublecomplex *, doublecomplex *, int *, doublecomplex *, doublecomplex *, doublecomplex *, blasint *, doublecomplex *,
int *, doublecomplex *, doublecomplex *, int *, ftnlen), blasint *, doublecomplex *, doublecomplex *, blasint *, ftnlen),
zcopy_(int *, doublecomplex *, int *, doublecomplex *, zcopy_(int *, doublecomplex *, blasint *, doublecomplex *,
int *), zswap_(int *, doublecomplex *, int *, blasint *), zswap_(int *, doublecomplex *, blasint *,
doublecomplex *, int *); doublecomplex *, blasint *);
extern double dlamch_(char *, ftnlen); extern double dlamch_(char *, ftnlen);
static double absakk; static double absakk;
extern /* Subroutine */ int zdscal_(int *, double *, extern /* Subroutine */ blasint zdscal_(int *, double *,
doublecomplex *, int *); doublecomplex *, blasint *);
static double colmax; static double colmax;
extern /* Subroutine */ int zlacgv_(int *, doublecomplex *, int *) extern /* Subroutine */ blasint zlacgv_(int *, doublecomplex *, blasint *)
; ;
extern int izamax_(int *, doublecomplex *, int *); extern blasint izamax_(int *, doublecomplex *, blasint *);
static double rowmax; static double rowmax;
/* Parameter adjustments */ /* Parameter adjustments */

28
relapack/src/zlauum.c
View File

@ -1,7 +1,7 @@
#include "relapack.h" #include "relapack.h"
static void RELAPACK_zlauum_rec(const char *, const int *, double *, static void RELAPACK_zlauum_rec(const char *, const blasint *, double *,
const int *, int *); const blasint *, blasint *);
/** ZLAUUM computes the product U * U**H or L**H * L, where the triangular factor U or L is stored in the upper or lower triangular part of the array A. /** ZLAUUM computes the product U * U**H or L**H * L, where the triangular factor U or L is stored in the upper or lower triangular part of the array A.
@ -11,14 +11,14 @@ static void RELAPACK_zlauum_rec(const char *, const int *, double *,
* http://www.netlib.org/lapack/explore-html/d8/d45/zlauum_8f.html * http://www.netlib.org/lapack/explore-html/d8/d45/zlauum_8f.html
* */ * */
void RELAPACK_zlauum( void RELAPACK_zlauum(
const char *uplo, const int *n, const char *uplo, const blasint *n,
double *A, const int *ldA, double *A, const blasint *ldA,
int *info blasint *info
) { ) {
// Check arguments // Check arguments
const int lower = LAPACK(lsame)(uplo, "L"); const blasint lower = LAPACK(lsame)(uplo, "L");
const int upper = LAPACK(lsame)(uplo, "U"); const blasint upper = LAPACK(lsame)(uplo, "U");
*info = 0; *info = 0;
if (!lower && !upper) if (!lower && !upper)
*info = -1; *info = -1;
@ -27,8 +27,8 @@ void RELAPACK_zlauum(
else if (*ldA < MAX(1, *n)) else if (*ldA < MAX(1, *n))
*info = -4; *info = -4;
if (*info) { if (*info) {
const int minfo = -*info; const blasint minfo = -*info;
LAPACK(xerbla)("ZLAUUM", &minfo); LAPACK(xerbla)("ZLAUUM", &minfo, strlen("ZLAUUM"));
return; return;
} }
@ -42,9 +42,9 @@ void RELAPACK_zlauum(
/** zlauum's recursive compute kernel */ /** zlauum's recursive compute kernel */
static void RELAPACK_zlauum_rec( static void RELAPACK_zlauum_rec(
const char *uplo, const int *n, const char *uplo, const blasint *n,
double *A, const int *ldA, double *A, const blasint *ldA,
int *info blasint *info
) { ) {
if (*n <= MAX(CROSSOVER_ZLAUUM, 1)) { if (*n <= MAX(CROSSOVER_ZLAUUM, 1)) {
@ -57,8 +57,8 @@ static void RELAPACK_zlauum_rec(
const double ONE[] = { 1., 0. }; const double ONE[] = { 1., 0. };
// Splitting // Splitting
const int n1 = ZREC_SPLIT(*n); const blasint n1 = ZREC_SPLIT(*n);
const int n2 = *n - n1; const blasint n2 = *n - n1;
// A_TL A_TR // A_TL A_TR
// A_BL A_BR // A_BL A_BR

42
relapack/src/zpbtrf.c
View File

@ -1,8 +1,8 @@
#include "relapack.h" #include "relapack.h"
#include "stdlib.h" #include "stdlib.h"
static void RELAPACK_zpbtrf_rec(const char *, const int *, const int *, static void RELAPACK_zpbtrf_rec(const char *, const blasint *, const blasint *,
double *, const int *, double *, const int *, int *); double *, const blasint *, double *, const blasint *, blasint *);
/** ZPBTRF computes the Cholesky factorization of a complex Hermitian positive definite band matrix A. /** ZPBTRF computes the Cholesky factorization of a complex Hermitian positive definite band matrix A.
@ -12,14 +12,14 @@ static void RELAPACK_zpbtrf_rec(const char *, const int *, const int *,
* http://www.netlib.org/lapack/explore-html/db/da9/zpbtrf_8f.html * http://www.netlib.org/lapack/explore-html/db/da9/zpbtrf_8f.html
* */ * */
void RELAPACK_zpbtrf( void RELAPACK_zpbtrf(
const char *uplo, const int *n, const int *kd, const char *uplo, const blasint *n, const blasint *kd,
double *Ab, const int *ldAb, double *Ab, const blasint *ldAb,
int *info blasint *info
) { ) {
// Check arguments // Check arguments
const int lower = LAPACK(lsame)(uplo, "L"); const blasint lower = LAPACK(lsame)(uplo, "L");
const int upper = LAPACK(lsame)(uplo, "U"); const blasint upper = LAPACK(lsame)(uplo, "U");
*info = 0; *info = 0;
if (!lower && !upper) if (!lower && !upper)
*info = -1; *info = -1;
@ -30,8 +30,8 @@ void RELAPACK_zpbtrf(
else if (*ldAb < *kd + 1) else if (*ldAb < *kd + 1)
*info = -5; *info = -5;
if (*info) { if (*info) {
const int minfo = -*info; const blasint minfo = -*info;
LAPACK(xerbla)("ZPBTRF", &minfo); LAPACK(xerbla)("ZPBTRF", &minfo, strlen("ZPBTRF"));
return; return;
} }
@ -42,9 +42,9 @@ void RELAPACK_zpbtrf(
const double ZERO[] = { 0., 0. }; const double ZERO[] = { 0., 0. };
// Allocate work space // Allocate work space
const int n1 = ZREC_SPLIT(*n); const blasint n1 = ZREC_SPLIT(*n);
const int mWork = (*kd > n1) ? (lower ? *n - *kd : n1) : *kd; const blasint mWork = (*kd > n1) ? (lower ? *n - *kd : n1) : *kd;
const int nWork = (*kd > n1) ? (lower ? n1 : *n - *kd) : *kd; const blasint nWork = (*kd > n1) ? (lower ? n1 : *n - *kd) : *kd;
double *Work = malloc(mWork * nWork * 2 * sizeof(double)); double *Work = malloc(mWork * nWork * 2 * sizeof(double));
LAPACK(zlaset)(uplo, &mWork, &nWork, ZERO, ZERO, Work, &mWork); LAPACK(zlaset)(uplo, &mWork, &nWork, ZERO, ZERO, Work, &mWork);
@ -58,10 +58,10 @@ void RELAPACK_zpbtrf(
/** zpbtrf's recursive compute kernel */ /** zpbtrf's recursive compute kernel */
static void RELAPACK_zpbtrf_rec( static void RELAPACK_zpbtrf_rec(
const char *uplo, const int *n, const int *kd, const char *uplo, const blasint *n, const blasint *kd,
double *Ab, const int *ldAb, double *Ab, const blasint *ldAb,
double *Work, const int *ldWork, double *Work, const blasint *ldWork,
int *info blasint *info
){ ){
if (*n <= MAX(CROSSOVER_ZPBTRF, 1)) { if (*n <= MAX(CROSSOVER_ZPBTRF, 1)) {
@ -75,12 +75,12 @@ static void RELAPACK_zpbtrf_rec(
const double MONE[] = { -1., 0. }; const double MONE[] = { -1., 0. };
// Unskew A // Unskew A
const int ldA[] = { *ldAb - 1 }; const blasint ldA[] = { *ldAb - 1 };
double *const A = Ab + 2 * ((*uplo == 'L') ? 0 : *kd); double *const A = Ab + 2 * ((*uplo == 'L') ? 0 : *kd);
// Splitting // Splitting
const int n1 = MIN(ZREC_SPLIT(*n), *kd); const blasint n1 = MIN(ZREC_SPLIT(*n), *kd);
const int n2 = *n - n1; const blasint n2 = *n - n1;
// * * // * *
// * Ab_BR // * Ab_BR
@ -99,8 +99,8 @@ static void RELAPACK_zpbtrf_rec(
return; return;
// Banded splitting // Banded splitting
const int n21 = MIN(n2, *kd - n1); const blasint n21 = MIN(n2, *kd - n1);
const int n22 = MIN(n2 - n21, *kd); const blasint n22 = MIN(n2 - n21, *kd);
// n1 n21 n22 // n1 n21 n22
// n1 * A_TRl A_TRr // n1 * A_TRl A_TRr

28
relapack/src/zpotrf.c
View File

@ -1,7 +1,7 @@
#include "relapack.h" #include "relapack.h"
static void RELAPACK_zpotrf_rec(const char *, const int *, double *, static void RELAPACK_zpotrf_rec(const char *, const blasint *, double *,
const int *, int *); const blasint *, blasint *);
/** ZPOTRF computes the Cholesky factorization of a complex Hermitian positive definite matrix A. /** ZPOTRF computes the Cholesky factorization of a complex Hermitian positive definite matrix A.
@ -11,14 +11,14 @@ static void RELAPACK_zpotrf_rec(const char *, const int *, double *,
* http://www.netlib.org/lapack/explore-html/d1/db9/zpotrf_8f.html * http://www.netlib.org/lapack/explore-html/d1/db9/zpotrf_8f.html
* */ * */
void RELAPACK_zpotrf( void RELAPACK_zpotrf(
const char *uplo, const int *n, const char *uplo, const blasint *n,
double *A, const int *ldA, double *A, const blasint *ldA,
int *info blasint *info
) { ) {
// Check arguments // Check arguments
const int lower = LAPACK(lsame)(uplo, "L"); const blasint lower = LAPACK(lsame)(uplo, "L");
const int upper = LAPACK(lsame)(uplo, "U"); const blasint upper = LAPACK(lsame)(uplo, "U");
*info = 0; *info = 0;
if (!lower && !upper) if (!lower && !upper)
*info = -1; *info = -1;
@ -27,8 +27,8 @@ void RELAPACK_zpotrf(
else if (*ldA < MAX(1, *n)) else if (*ldA < MAX(1, *n))
*info = -4; *info = -4;
if (*info) { if (*info) {
const int minfo = -*info; const blasint minfo = -*info;
LAPACK(xerbla)("ZPOTRF", &minfo); LAPACK(xerbla)("ZPOTRF", &minfo, strlen("ZPOTRF"));
return; return;
} }
@ -42,9 +42,9 @@ void RELAPACK_zpotrf(
/** zpotrf's recursive compute kernel */ /** zpotrf's recursive compute kernel */
static void RELAPACK_zpotrf_rec( static void RELAPACK_zpotrf_rec(
const char *uplo, const int *n, const char *uplo, const blasint *n,
double *A, const int *ldA, double *A, const blasint *ldA,
int *info blasint *info
) { ) {
if (*n <= MAX(CROSSOVER_ZPOTRF, 1)) { if (*n <= MAX(CROSSOVER_ZPOTRF, 1)) {
@ -58,8 +58,8 @@ static void RELAPACK_zpotrf_rec(
const double MONE[] = { -1., 0. }; const double MONE[] = { -1., 0. };
// Splitting // Splitting
const int n1 = ZREC_SPLIT(*n); const blasint n1 = ZREC_SPLIT(*n);
const int n2 = *n - n1; const blasint n2 = *n - n1;
// A_TL A_TR // A_TL A_TR
// A_BL A_BR // A_BL A_BR

72
relapack/src/zsytrf.c
View File

@ -3,8 +3,8 @@
#include <stdlib.h> #include <stdlib.h>
#endif #endif
static void RELAPACK_zsytrf_rec(const char *, const int *, const int *, int *, static void RELAPACK_zsytrf_rec(const char *, const blasint *, const blasint *, blasint *,
double *, const int *, int *, double *, const int *, int *); double *, const blasint *, blasint *, double *, const blasint *, blasint *);
/** ZSYTRF computes the factorization of a complex symmetric matrix A using the Bunch-Kaufman diagonal pivoting method. /** ZSYTRF computes the factorization of a complex symmetric matrix A using the Bunch-Kaufman diagonal pivoting method.
@ -14,21 +14,21 @@ static void RELAPACK_zsytrf_rec(const char *, const int *, const int *, int *,
* http://www.netlib.org/lapack/explore-html/da/d94/zsytrf_8f.html * http://www.netlib.org/lapack/explore-html/da/d94/zsytrf_8f.html
* */ * */
void RELAPACK_zsytrf( void RELAPACK_zsytrf(
const char *uplo, const int *n, const char *uplo, const blasint *n,
double *A, const int *ldA, int *ipiv, double *A, const blasint *ldA, blasint *ipiv,
double *Work, const int *lWork, int *info double *Work, const blasint *lWork, blasint *info
) { ) {
// Required work size // Required work size
const int cleanlWork = *n * (*n / 2); const blasint cleanlWork = *n * (*n / 2);
int minlWork = cleanlWork; blasint minlWork = cleanlWork;
#if XSYTRF_ALLOW_MALLOC #if XSYTRF_ALLOW_MALLOC
minlWork = 1; minlWork = 1;
#endif #endif
// Check arguments // Check arguments
const int lower = LAPACK(lsame)(uplo, "L"); const blasint lower = LAPACK(lsame)(uplo, "L");
const int upper = LAPACK(lsame)(uplo, "U"); const blasint upper = LAPACK(lsame)(uplo, "U");
*info = 0; *info = 0;
if (!lower && !upper) if (!lower && !upper)
*info = -1; *info = -1;
@ -55,8 +55,8 @@ void RELAPACK_zsytrf(
#endif #endif
if (*info) { if (*info) {
const int minfo = -*info; const blasint minfo = -*info;
LAPACK(xerbla)("ZSYTRF", &minfo); LAPACK(xerbla)("ZSYTRF", &minfo, strlen("ZSYTRF"));
return; return;
} }
@ -64,7 +64,7 @@ void RELAPACK_zsytrf(
const char cleanuplo = lower ? 'L' : 'U'; const char cleanuplo = lower ? 'L' : 'U';
// Dummy arguments // Dummy arguments
int nout; blasint nout;
// Recursive kernel // Recursive kernel
RELAPACK_zsytrf_rec(&cleanuplo, n, n, &nout, A, ldA, ipiv, cleanWork, n, info); RELAPACK_zsytrf_rec(&cleanuplo, n, n, &nout, A, ldA, ipiv, cleanWork, n, info);
@ -78,13 +78,13 @@ void RELAPACK_zsytrf(
/** zsytrf's recursive compute kernel */ /** zsytrf's recursive compute kernel */
static void RELAPACK_zsytrf_rec( static void RELAPACK_zsytrf_rec(
const char *uplo, const int *n_full, const int *n, int *n_out, const char *uplo, const blasint *n_full, const blasint *n, blasint *n_out,
double *A, const int *ldA, int *ipiv, double *A, const blasint *ldA, blasint *ipiv,
double *Work, const int *ldWork, int *info double *Work, const blasint *ldWork, blasint *info
) { ) {
// top recursion level? // top recursion level?
const int top = *n_full == *n; const blasint top = *n_full == *n;
if (*n <= MAX(CROSSOVER_ZSYTRF, 3)) { if (*n <= MAX(CROSSOVER_ZSYTRF, 3)) {
// Unblocked // Unblocked
@ -96,34 +96,34 @@ static void RELAPACK_zsytrf_rec(
return; return;
} }
int info1, info2; blasint info1, info2;
// Constants // Constants
const double ONE[] = { 1., 0. }; const double ONE[] = { 1., 0. };
const double MONE[] = { -1., 0. }; const double MONE[] = { -1., 0. };
const int iONE[] = { 1 }; const blasint iONE[] = { 1 };
// Loop iterator // Loop iterator
int i; blasint i;
const int n_rest = *n_full - *n; const blasint n_rest = *n_full - *n;
if (*uplo == 'L') { if (*uplo == 'L') {
// Splitting (setup) // Splitting (setup)
int n1 = ZREC_SPLIT(*n); blasint n1 = ZREC_SPLIT(*n);
int n2 = *n - n1; blasint n2 = *n - n1;
// Work_L * // Work_L *
double *const Work_L = Work; double *const Work_L = Work;
// recursion(A_L) // recursion(A_L)
int n1_out; blasint n1_out;
RELAPACK_zsytrf_rec(uplo, n_full, &n1, &n1_out, A, ldA, ipiv, Work_L, ldWork, &info1); RELAPACK_zsytrf_rec(uplo, n_full, &n1, &n1_out, A, ldA, ipiv, Work_L, ldWork, &info1);
n1 = n1_out; n1 = n1_out;
// Splitting (continued) // Splitting (continued)
n2 = *n - n1; n2 = *n - n1;
const int n_full2 = *n_full - n1; const blasint n_full2 = *n_full - n1;
// * * // * *
// A_BL A_BR // A_BL A_BR
@ -139,23 +139,23 @@ static void RELAPACK_zsytrf_rec(
// (top recursion level: use Work as Work_BR) // (top recursion level: use Work as Work_BR)
double *const Work_BL = Work + 2 * n1; double *const Work_BL = Work + 2 * n1;
double *const Work_BR = top ? Work : Work + 2 * *ldWork * n1 + 2 * n1; double *const Work_BR = top ? Work : Work + 2 * *ldWork * n1 + 2 * n1;
const int ldWork_BR = top ? n2 : *ldWork; const blasint ldWork_BR = top ? n2 : *ldWork;
// ipiv_T // ipiv_T
// ipiv_B // ipiv_B
int *const ipiv_B = ipiv + n1; blasint *const ipiv_B = ipiv + n1;
// A_BR = A_BR - A_BL Work_BL' // A_BR = A_BR - A_BL Work_BL'
RELAPACK_zgemmt(uplo, "N", "T", &n2, &n1, MONE, A_BL, ldA, Work_BL, ldWork, ONE, A_BR, ldA); RELAPACK_zgemmt(uplo, "N", "T", &n2, &n1, MONE, A_BL, ldA, Work_BL, ldWork, ONE, A_BR, ldA);
BLAS(zgemm)("N", "T", &n_rest, &n2, &n1, MONE, A_BL_B, ldA, Work_BL, ldWork, ONE, A_BR_B, ldA); BLAS(zgemm)("N", "T", &n_rest, &n2, &n1, MONE, A_BL_B, ldA, Work_BL, ldWork, ONE, A_BR_B, ldA);
// recursion(A_BR) // recursion(A_BR)
int n2_out; blasint n2_out;
RELAPACK_zsytrf_rec(uplo, &n_full2, &n2, &n2_out, A_BR, ldA, ipiv_B, Work_BR, &ldWork_BR, &info2); RELAPACK_zsytrf_rec(uplo, &n_full2, &n2, &n2_out, A_BR, ldA, ipiv_B, Work_BR, &ldWork_BR, &info2);
if (n2_out != n2) { if (n2_out != n2) {
// undo 1 column of updates // undo 1 column of updates
const int n_restp1 = n_rest + 1; const blasint n_restp1 = n_rest + 1;
// last column of A_BR // last column of A_BR
double *const A_BR_r = A_BR + 2 * *ldA * n2_out + 2 * n2_out; double *const A_BR_r = A_BR + 2 * *ldA * n2_out + 2 * n2_out;
@ -182,22 +182,22 @@ static void RELAPACK_zsytrf_rec(
*n_out = n1 + n2; *n_out = n1 + n2;
} else { } else {
// Splitting (setup) // Splitting (setup)
int n2 = ZREC_SPLIT(*n); blasint n2 = ZREC_SPLIT(*n);
int n1 = *n - n2; blasint n1 = *n - n2;
// * Work_R // * Work_R
// (top recursion level: use Work as Work_R) // (top recursion level: use Work as Work_R)
double *const Work_R = top ? Work : Work + 2 * *ldWork * n1; double *const Work_R = top ? Work : Work + 2 * *ldWork * n1;
// recursion(A_R) // recursion(A_R)
int n2_out; blasint n2_out;
RELAPACK_zsytrf_rec(uplo, n_full, &n2, &n2_out, A, ldA, ipiv, Work_R, ldWork, &info2); RELAPACK_zsytrf_rec(uplo, n_full, &n2, &n2_out, A, ldA, ipiv, Work_R, ldWork, &info2);
const int n2_diff = n2 - n2_out; const blasint n2_diff = n2 - n2_out;
n2 = n2_out; n2 = n2_out;
// Splitting (continued) // Splitting (continued)
n1 = *n - n2; n1 = *n - n2;
const int n_full1 = *n_full - n2; const blasint n_full1 = *n_full - n2;
// * A_TL_T A_TR_T // * A_TL_T A_TR_T
// * A_TL A_TR // * A_TL A_TR
@ -213,19 +213,19 @@ static void RELAPACK_zsytrf_rec(
// (top recursion level: Work_R was Work) // (top recursion level: Work_R was Work)
double *const Work_L = Work; double *const Work_L = Work;
double *const Work_TR = Work + 2 * *ldWork * (top ? n2_diff : n1) + 2 * n_rest; double *const Work_TR = Work + 2 * *ldWork * (top ? n2_diff : n1) + 2 * n_rest;
const int ldWork_L = top ? n1 : *ldWork; const blasint ldWork_L = top ? n1 : *ldWork;
// A_TL = A_TL - A_TR Work_TR' // A_TL = A_TL - A_TR Work_TR'
RELAPACK_zgemmt(uplo, "N", "T", &n1, &n2, MONE, A_TR, ldA, Work_TR, ldWork, ONE, A_TL, ldA); RELAPACK_zgemmt(uplo, "N", "T", &n1, &n2, MONE, A_TR, ldA, Work_TR, ldWork, ONE, A_TL, ldA);
BLAS(zgemm)("N", "T", &n_rest, &n1, &n2, MONE, A_TR_T, ldA, Work_TR, ldWork, ONE, A_TL_T, ldA); BLAS(zgemm)("N", "T", &n_rest, &n1, &n2, MONE, A_TR_T, ldA, Work_TR, ldWork, ONE, A_TL_T, ldA);
// recursion(A_TL) // recursion(A_TL)
int n1_out; blasint n1_out;
RELAPACK_zsytrf_rec(uplo, &n_full1, &n1, &n1_out, A, ldA, ipiv, Work_L, &ldWork_L, &info1); RELAPACK_zsytrf_rec(uplo, &n_full1, &n1, &n1_out, A, ldA, ipiv, Work_L, &ldWork_L, &info1);
if (n1_out != n1) { if (n1_out != n1) {
// undo 1 column of updates // undo 1 column of updates
const int n_restp1 = n_rest + 1; const blasint n_restp1 = n_rest + 1;
// A_TL_T_l = A_TL_T_l + A_TR_T Work_TR_t' // A_TL_T_l = A_TL_T_l + A_TR_T Work_TR_t'
BLAS(zgemv)("N", &n_restp1, &n2, ONE, A_TR_T, ldA, Work_TR, ldWork, ONE, A_TL_T, iONE); BLAS(zgemv)("N", &n_restp1, &n2, ONE, A_TR_T, ldA, Work_TR, ldWork, ONE, A_TL_T, iONE);

34
relapack/src/zsytrf_rec2.c
View File

@ -15,7 +15,7 @@
/* Table of constant values */ /* Table of constant values */
static doublecomplex c_b1 = {1.,0.}; static doublecomplex c_b1 = {1.,0.};
static int c__1 = 1; static blasint c__1 = 1;
/** ZSYTRF_REC2 computes a partial factorization of a complex symmetric matrix using the Bunch-Kaufman diagon al pivoting method. /** ZSYTRF_REC2 computes a partial factorization of a complex symmetric matrix using the Bunch-Kaufman diagon al pivoting method.
* *
@ -24,12 +24,12 @@ static int c__1 = 1;
* The blocked BLAS Level 3 updates were removed and moved to the * The blocked BLAS Level 3 updates were removed and moved to the
* recursive algorithm. * recursive algorithm.
* */ * */
/* Subroutine */ void RELAPACK_zsytrf_rec2(char *uplo, int *n, int * /* Subroutine */ void RELAPACK_zsytrf_rec2(char *uplo, blasint *n, blasint *
nb, int *kb, doublecomplex *a, int *lda, int *ipiv, nb, blasint *kb, doublecomplex *a, blasint *lda, blasint *ipiv,
doublecomplex *w, int *ldw, int *info, ftnlen uplo_len) doublecomplex *w, blasint *ldw, blasint *info, ftnlen uplo_len)
{ {
/* System generated locals */ /* System generated locals */
int a_dim1, a_offset, w_dim1, w_offset, i__1, i__2, i__3, i__4; blasint a_dim1, a_offset, w_dim1, w_offset, i__1, i__2, i__3, i__4;
double d__1, d__2, d__3, d__4; double d__1, d__2, d__3, d__4;
doublecomplex z__1, z__2, z__3; doublecomplex z__1, z__2, z__3;
@ -38,22 +38,22 @@ static int c__1 = 1;
void z_div(doublecomplex *, doublecomplex *, doublecomplex *); void z_div(doublecomplex *, doublecomplex *, doublecomplex *);
/* Local variables */ /* Local variables */
static int j, k; static blasint j, k;
static doublecomplex t, r1, d11, d21, d22; static doublecomplex t, r1, d11, d21, d22;
static int jj, kk, jp, kp, kw, kkw, imax, jmax; static blasint jj, kk, jp, kp, kw, kkw, imax, jmax;
static double alpha; static double alpha;
extern logical lsame_(char *, char *, ftnlen, ftnlen); extern logical lsame_(char *, char *, ftnlen, ftnlen);
extern /* Subroutine */ int zscal_(int *, doublecomplex *, extern /* Subroutine */ blasint zscal_(int *, doublecomplex *,
doublecomplex *, int *); doublecomplex *, blasint *);
static int kstep; static blasint kstep;
extern /* Subroutine */ int zgemv_(char *, int *, int *, extern /* Subroutine */ blasint zgemv_(char *, blasint *, blasint *,
doublecomplex *, doublecomplex *, int *, doublecomplex *, doublecomplex *, doublecomplex *, blasint *, doublecomplex *,
int *, doublecomplex *, doublecomplex *, int *, ftnlen), blasint *, doublecomplex *, doublecomplex *, blasint *, ftnlen),
zcopy_(int *, doublecomplex *, int *, doublecomplex *, zcopy_(int *, doublecomplex *, blasint *, doublecomplex *,
int *), zswap_(int *, doublecomplex *, int *, blasint *), zswap_(int *, doublecomplex *, blasint *,
doublecomplex *, int *); doublecomplex *, blasint *);
static double absakk, colmax; static double absakk, colmax;
extern int izamax_(int *, doublecomplex *, int *); extern blasint izamax_(int *, doublecomplex *, blasint *);
static double rowmax; static double rowmax;
/* Parameter adjustments */ /* Parameter adjustments */

72
relapack/src/zsytrf_rook.c
View File

@ -3,8 +3,8 @@
#include <stdlib.h> #include <stdlib.h>
#endif #endif
static void RELAPACK_zsytrf_rook_rec(const char *, const int *, const int *, int *, static void RELAPACK_zsytrf_rook_rec(const char *, const blasint *, const blasint *, blasint *,
double *, const int *, int *, double *, const int *, int *); double *, const blasint *, blasint *, double *, const blasint *, blasint *);
/** ZSYTRF_ROOK computes the factorization of a complex symmetric matrix A using the bounded Bunch-Kaufman ("rook") diagonal pivoting method. /** ZSYTRF_ROOK computes the factorization of a complex symmetric matrix A using the bounded Bunch-Kaufman ("rook") diagonal pivoting method.
@ -14,21 +14,21 @@ static void RELAPACK_zsytrf_rook_rec(const char *, const int *, const int *, int
* http://www.netlib.org/lapack/explore-html/d6/d6e/zsytrf__rook_8f.html * http://www.netlib.org/lapack/explore-html/d6/d6e/zsytrf__rook_8f.html
* */ * */
void RELAPACK_zsytrf_rook( void RELAPACK_zsytrf_rook(
const char *uplo, const int *n, const char *uplo, const blasint *n,
double *A, const int *ldA, int *ipiv, double *A, const blasint *ldA, blasint *ipiv,
double *Work, const int *lWork, int *info double *Work, const blasint *lWork, blasint *info
) { ) {
// Required work size // Required work size
const int cleanlWork = *n * (*n / 2); const blasint cleanlWork = *n * (*n / 2);
int minlWork = cleanlWork; blasint minlWork = cleanlWork;
#if XSYTRF_ALLOW_MALLOC #if XSYTRF_ALLOW_MALLOC
minlWork = 1; minlWork = 1;
#endif #endif
// Check arguments // Check arguments
const int lower = LAPACK(lsame)(uplo, "L"); const blasint lower = LAPACK(lsame)(uplo, "L");
const int upper = LAPACK(lsame)(uplo, "U"); const blasint upper = LAPACK(lsame)(uplo, "U");
*info = 0; *info = 0;
if (!lower && !upper) if (!lower && !upper)
*info = -1; *info = -1;
@ -55,8 +55,8 @@ void RELAPACK_zsytrf_rook(
#endif #endif
if (*info) { if (*info) {
const int minfo = -*info; const blasint minfo = -*info;
LAPACK(xerbla)("ZSYTRF", &minfo); LAPACK(xerbla)("ZSYTRF", &minfo, strlen("ZSYTRF"));
return; return;
} }
@ -64,7 +64,7 @@ void RELAPACK_zsytrf_rook(
const char cleanuplo = lower ? 'L' : 'U'; const char cleanuplo = lower ? 'L' : 'U';
// Dummy argument // Dummy argument
int nout; blasint nout;
// Recursive kernel // Recursive kernel
RELAPACK_zsytrf_rook_rec(&cleanuplo, n, n, &nout, A, ldA, ipiv, cleanWork, n, info); RELAPACK_zsytrf_rook_rec(&cleanuplo, n, n, &nout, A, ldA, ipiv, cleanWork, n, info);
@ -78,13 +78,13 @@ void RELAPACK_zsytrf_rook(
/** zsytrf_rook's recursive compute kernel */ /** zsytrf_rook's recursive compute kernel */
static void RELAPACK_zsytrf_rook_rec( static void RELAPACK_zsytrf_rook_rec(
const char *uplo, const int *n_full, const int *n, int *n_out, const char *uplo, const blasint *n_full, const blasint *n, blasint *n_out,
double *A, const int *ldA, int *ipiv, double *A, const blasint *ldA, blasint *ipiv,
double *Work, const int *ldWork, int *info double *Work, const blasint *ldWork, blasint *info
) { ) {
// top recursion level? // top recursion level?
const int top = *n_full == *n; const blasint top = *n_full == *n;
if (*n <= MAX(CROSSOVER_ZSYTRF_ROOK, 3)) { if (*n <= MAX(CROSSOVER_ZSYTRF_ROOK, 3)) {
// Unblocked // Unblocked
@ -96,31 +96,31 @@ static void RELAPACK_zsytrf_rook_rec(
return; return;
} }
int info1, info2; blasint info1, info2;
// Constants // Constants
const double ONE[] = { 1., 0. }; const double ONE[] = { 1., 0. };
const double MONE[] = { -1., 0. }; const double MONE[] = { -1., 0. };
const int iONE[] = { 1 }; const blasint iONE[] = { 1 };
const int n_rest = *n_full - *n; const blasint n_rest = *n_full - *n;
if (*uplo == 'L') { if (*uplo == 'L') {
// Splitting (setup) // Splitting (setup)
int n1 = ZREC_SPLIT(*n); blasint n1 = ZREC_SPLIT(*n);
int n2 = *n - n1; blasint n2 = *n - n1;
// Work_L * // Work_L *
double *const Work_L = Work; double *const Work_L = Work;
// recursion(A_L) // recursion(A_L)
int n1_out; blasint n1_out;
RELAPACK_zsytrf_rook_rec(uplo, n_full, &n1, &n1_out, A, ldA, ipiv, Work_L, ldWork, &info1); RELAPACK_zsytrf_rook_rec(uplo, n_full, &n1, &n1_out, A, ldA, ipiv, Work_L, ldWork, &info1);
n1 = n1_out; n1 = n1_out;
// Splitting (continued) // Splitting (continued)
n2 = *n - n1; n2 = *n - n1;
const int n_full2 = *n_full - n1; const blasint n_full2 = *n_full - n1;
// * * // * *
// A_BL A_BR // A_BL A_BR
@ -136,23 +136,23 @@ static void RELAPACK_zsytrf_rook_rec(
// (top recursion level: use Work as Work_BR) // (top recursion level: use Work as Work_BR)
double *const Work_BL = Work + 2 * n1; double *const Work_BL = Work + 2 * n1;
double *const Work_BR = top ? Work : Work + 2 * *ldWork * n1 + 2 * n1; double *const Work_BR = top ? Work : Work + 2 * *ldWork * n1 + 2 * n1;
const int ldWork_BR = top ? n2 : *ldWork; const blasint ldWork_BR = top ? n2 : *ldWork;
// ipiv_T // ipiv_T
// ipiv_B // ipiv_B
int *const ipiv_B = ipiv + n1; blasint *const ipiv_B = ipiv + n1;
// A_BR = A_BR - A_BL Work_BL' // A_BR = A_BR - A_BL Work_BL'
RELAPACK_zgemmt(uplo, "N", "T", &n2, &n1, MONE, A_BL, ldA, Work_BL, ldWork, ONE, A_BR, ldA); RELAPACK_zgemmt(uplo, "N", "T", &n2, &n1, MONE, A_BL, ldA, Work_BL, ldWork, ONE, A_BR, ldA);
BLAS(zgemm)("N", "T", &n_rest, &n2, &n1, MONE, A_BL_B, ldA, Work_BL, ldWork, ONE, A_BR_B, ldA); BLAS(zgemm)("N", "T", &n_rest, &n2, &n1, MONE, A_BL_B, ldA, Work_BL, ldWork, ONE, A_BR_B, ldA);
// recursion(A_BR) // recursion(A_BR)
int n2_out; blasint n2_out;
RELAPACK_zsytrf_rook_rec(uplo, &n_full2, &n2, &n2_out, A_BR, ldA, ipiv_B, Work_BR, &ldWork_BR, &info2); RELAPACK_zsytrf_rook_rec(uplo, &n_full2, &n2, &n2_out, A_BR, ldA, ipiv_B, Work_BR, &ldWork_BR, &info2);
if (n2_out != n2) { if (n2_out != n2) {
// undo 1 column of updates // undo 1 column of updates
const int n_restp1 = n_rest + 1; const blasint n_restp1 = n_rest + 1;
// last column of A_BR // last column of A_BR
double *const A_BR_r = A_BR + 2 * *ldA * n2_out + 2 * n2_out; double *const A_BR_r = A_BR + 2 * *ldA * n2_out + 2 * n2_out;
@ -169,7 +169,7 @@ static void RELAPACK_zsytrf_rook_rec(
n2 = n2_out; n2 = n2_out;
// shift pivots // shift pivots
int i; blasint i;
for (i = 0; i < n2; i++) for (i = 0; i < n2; i++)
if (ipiv_B[i] > 0) if (ipiv_B[i] > 0)
ipiv_B[i] += n1; ipiv_B[i] += n1;
@ -180,22 +180,22 @@ static void RELAPACK_zsytrf_rook_rec(
*n_out = n1 + n2; *n_out = n1 + n2;
} else { } else {
// Splitting (setup) // Splitting (setup)
int n2 = ZREC_SPLIT(*n); blasint n2 = ZREC_SPLIT(*n);
int n1 = *n - n2; blasint n1 = *n - n2;
// * Work_R // * Work_R
// (top recursion level: use Work as Work_R) // (top recursion level: use Work as Work_R)
double *const Work_R = top ? Work : Work + 2 * *ldWork * n1; double *const Work_R = top ? Work : Work + 2 * *ldWork * n1;
// recursion(A_R) // recursion(A_R)
int n2_out; blasint n2_out;
RELAPACK_zsytrf_rook_rec(uplo, n_full, &n2, &n2_out, A, ldA, ipiv, Work_R, ldWork, &info2); RELAPACK_zsytrf_rook_rec(uplo, n_full, &n2, &n2_out, A, ldA, ipiv, Work_R, ldWork, &info2);
const int n2_diff = n2 - n2_out; const blasint n2_diff = n2 - n2_out;
n2 = n2_out; n2 = n2_out;
// Splitting (continued) // Splitting (continued)
n1 = *n - n2; n1 = *n - n2;
const int n_full1 = *n_full - n2; const blasint n_full1 = *n_full - n2;
// * A_TL_T A_TR_T // * A_TL_T A_TR_T
// * A_TL A_TR // * A_TL A_TR
@ -211,19 +211,19 @@ static void RELAPACK_zsytrf_rook_rec(
// (top recursion level: Work_R was Work) // (top recursion level: Work_R was Work)
double *const Work_L = Work; double *const Work_L = Work;
double *const Work_TR = Work + 2 * *ldWork * (top ? n2_diff : n1) + 2 * n_rest; double *const Work_TR = Work + 2 * *ldWork * (top ? n2_diff : n1) + 2 * n_rest;
const int ldWork_L = top ? n1 : *ldWork; const blasint ldWork_L = top ? n1 : *ldWork;
// A_TL = A_TL - A_TR Work_TR' // A_TL = A_TL - A_TR Work_TR'
RELAPACK_zgemmt(uplo, "N", "T", &n1, &n2, MONE, A_TR, ldA, Work_TR, ldWork, ONE, A_TL, ldA); RELAPACK_zgemmt(uplo, "N", "T", &n1, &n2, MONE, A_TR, ldA, Work_TR, ldWork, ONE, A_TL, ldA);
BLAS(zgemm)("N", "T", &n_rest, &n1, &n2, MONE, A_TR_T, ldA, Work_TR, ldWork, ONE, A_TL_T, ldA); BLAS(zgemm)("N", "T", &n_rest, &n1, &n2, MONE, A_TR_T, ldA, Work_TR, ldWork, ONE, A_TL_T, ldA);
// recursion(A_TL) // recursion(A_TL)
int n1_out; blasint n1_out;
RELAPACK_zsytrf_rook_rec(uplo, &n_full1, &n1, &n1_out, A, ldA, ipiv, Work_L, &ldWork_L, &info1); RELAPACK_zsytrf_rook_rec(uplo, &n_full1, &n1, &n1_out, A, ldA, ipiv, Work_L, &ldWork_L, &info1);
if (n1_out != n1) { if (n1_out != n1) {
// undo 1 column of updates // undo 1 column of updates
const int n_restp1 = n_rest + 1; const blasint n_restp1 = n_rest + 1;
// A_TL_T_l = A_TL_T_l + A_TR_T Work_TR_t' // A_TL_T_l = A_TL_T_l + A_TR_T Work_TR_t'
BLAS(zgemv)("N", &n_restp1, &n2, ONE, A_TR_T, ldA, Work_TR, ldWork, ONE, A_TL_T, iONE); BLAS(zgemv)("N", &n_restp1, &n2, ONE, A_TR_T, ldA, Work_TR, ldWork, ONE, A_TL_T, iONE);

36
relapack/src/zsytrf_rook_rec2.c
View File

@ -15,7 +15,7 @@
/* Table of constant values */ /* Table of constant values */
static doublecomplex c_b1 = {1.,0.}; static doublecomplex c_b1 = {1.,0.};
static int c__1 = 1; static blasint c__1 = 1;
/** ZSYTRF_ROOK_REC2 computes a partial factorization of a complex symmetric matrix using the bounded Bunch-K aufman ("rook") diagonal pivoting method. /** ZSYTRF_ROOK_REC2 computes a partial factorization of a complex symmetric matrix using the bounded Bunch-K aufman ("rook") diagonal pivoting method.
* *
@ -24,12 +24,12 @@ static int c__1 = 1;
* The blocked BLAS Level 3 updates were removed and moved to the * The blocked BLAS Level 3 updates were removed and moved to the
* recursive algorithm. * recursive algorithm.
* */ * */
/* Subroutine */ void RELAPACK_zsytrf_rook_rec2(char *uplo, int *n, /* Subroutine */ void RELAPACK_zsytrf_rook_rec2(char *uplo, blasint *n,
int *nb, int *kb, doublecomplex *a, int *lda, int * int *nb, blasint *kb, doublecomplex *a, blasint *lda, blasint *
ipiv, doublecomplex *w, int *ldw, int *info, ftnlen uplo_len) ipiv, doublecomplex *w, blasint *ldw, blasint *info, ftnlen uplo_len)
{ {
/* System generated locals */ /* System generated locals */
int a_dim1, a_offset, w_dim1, w_offset, i__1, i__2, i__3, i__4; blasint a_dim1, a_offset, w_dim1, w_offset, i__1, i__2, i__3, i__4;
double d__1, d__2; double d__1, d__2;
doublecomplex z__1, z__2, z__3, z__4; doublecomplex z__1, z__2, z__3, z__4;
@ -38,26 +38,26 @@ static int c__1 = 1;
void z_div(doublecomplex *, doublecomplex *, doublecomplex *); void z_div(doublecomplex *, doublecomplex *, doublecomplex *);
/* Local variables */ /* Local variables */
static int j, k, p; static blasint j, k, p;
static doublecomplex t, r1, d11, d12, d21, d22; static doublecomplex t, r1, d11, d12, d21, d22;
static int ii, jj, kk, kp, kw, jp1, jp2, kkw; static blasint ii, jj, kk, kp, kw, jp1, jp2, kkw;
static logical done; static logical done;
static int imax, jmax; static blasint imax, jmax;
static double alpha; static double alpha;
extern logical lsame_(char *, char *, ftnlen, ftnlen); extern logical lsame_(char *, char *, ftnlen, ftnlen);
static double dtemp, sfmin; static double dtemp, sfmin;
extern /* Subroutine */ int zscal_(int *, doublecomplex *, extern /* Subroutine */ blasint zscal_(int *, doublecomplex *,
doublecomplex *, int *); doublecomplex *, blasint *);
static int itemp, kstep; static blasint itemp, kstep;
extern /* Subroutine */ int zgemv_(char *, int *, int *, extern /* Subroutine */ blasint zgemv_(char *, blasint *, blasint *,
doublecomplex *, doublecomplex *, int *, doublecomplex *, doublecomplex *, doublecomplex *, blasint *, doublecomplex *,
int *, doublecomplex *, doublecomplex *, int *, ftnlen), blasint *, doublecomplex *, doublecomplex *, blasint *, ftnlen),
zcopy_(int *, doublecomplex *, int *, doublecomplex *, zcopy_(int *, doublecomplex *, blasint *, doublecomplex *,
int *), zswap_(int *, doublecomplex *, int *, blasint *), zswap_(int *, doublecomplex *, blasint *,
doublecomplex *, int *); doublecomplex *, blasint *);
extern double dlamch_(char *, ftnlen); extern double dlamch_(char *, ftnlen);
static double absakk, colmax; static double absakk, colmax;
extern int izamax_(int *, doublecomplex *, int *); extern blasint izamax_(int *, doublecomplex *, blasint *);
static double rowmax; static double rowmax;
/* Parameter adjustments */ /* Parameter adjustments */

62
relapack/src/ztgsyl.c
View File

@ -1,10 +1,10 @@
#include "relapack.h" #include "relapack.h"
#include <math.h> #include <math.h>
static void RELAPACK_ztgsyl_rec(const char *, const int *, const int *, static void RELAPACK_ztgsyl_rec(const char *, const blasint *, const blasint *,
const int *, const double *, const int *, const double *, const int *, const blasint *, const double *, const blasint *, const double *, const blasint *,
double *, const int *, const double *, const int *, const double *, double *, const blasint *, const double *, const blasint *, const double *,
const int *, double *, const int *, double *, double *, double *, int *); const blasint *, double *, const blasint *, double *, double *, double *, blasint *);
/** ZTGSYL solves the generalized Sylvester equation. /** ZTGSYL solves the generalized Sylvester equation.
@ -14,21 +14,21 @@ static void RELAPACK_ztgsyl_rec(const char *, const int *, const int *,
* http://www.netlib.org/lapack/explore-html/db/d68/ztgsyl_8f.html * http://www.netlib.org/lapack/explore-html/db/d68/ztgsyl_8f.html
* */ * */
void RELAPACK_ztgsyl( void RELAPACK_ztgsyl(
const char *trans, const int *ijob, const int *m, const int *n, const char *trans, const blasint *ijob, const blasint *m, const blasint *n,
const double *A, const int *ldA, const double *B, const int *ldB, const double *A, const blasint *ldA, const double *B, const blasint *ldB,
double *C, const int *ldC, double *C, const blasint *ldC,
const double *D, const int *ldD, const double *E, const int *ldE, const double *D, const blasint *ldD, const double *E, const blasint *ldE,
double *F, const int *ldF, double *F, const blasint *ldF,
double *scale, double *dif, double *scale, double *dif,
double *Work, const int *lWork, int *iWork, int *info double *Work, const blasint *lWork, blasint *iWork, blasint *info
) { ) {
// Parse arguments // Parse arguments
const int notran = LAPACK(lsame)(trans, "N"); const blasint notran = LAPACK(lsame)(trans, "N");
const int tran = LAPACK(lsame)(trans, "C"); const blasint tran = LAPACK(lsame)(trans, "C");
// Compute work buffer size // Compute work buffer size
int lwmin = 1; blasint lwmin = 1;
if (notran && (*ijob == 1 || *ijob == 2)) if (notran && (*ijob == 1 || *ijob == 2))
lwmin = MAX(1, 2 * *m * *n); lwmin = MAX(1, 2 * *m * *n);
*info = 0; *info = 0;
@ -57,8 +57,8 @@ void RELAPACK_ztgsyl(
else if (*lWork < lwmin && *lWork != -1) else if (*lWork < lwmin && *lWork != -1)
*info = -20; *info = -20;
if (*info) { if (*info) {
const int minfo = -*info; const blasint minfo = -*info;
LAPACK(xerbla)("ZTGSYL", &minfo); LAPACK(xerbla)("ZTGSYL", &minfo, strlen("ZTGSYL"));
return; return;
} }
@ -74,8 +74,8 @@ void RELAPACK_ztgsyl(
// Constant // Constant
const double ZERO[] = { 0., 0. }; const double ZERO[] = { 0., 0. };
int isolve = 1; blasint isolve = 1;
int ifunc = 0; blasint ifunc = 0;
if (notran) { if (notran) {
if (*ijob >= 3) { if (*ijob >= 3) {
ifunc = *ijob - 2; ifunc = *ijob - 2;
@ -86,7 +86,7 @@ void RELAPACK_ztgsyl(
} }
double scale2; double scale2;
int iround; blasint iround;
for (iround = 1; iround <= isolve; iround++) { for (iround = 1; iround <= isolve; iround++) {
*scale = 1; *scale = 1;
double dscale = 0; double dscale = 0;
@ -119,13 +119,13 @@ void RELAPACK_ztgsyl(
/** ztgsyl's recursive vompute kernel */ /** ztgsyl's recursive vompute kernel */
static void RELAPACK_ztgsyl_rec( static void RELAPACK_ztgsyl_rec(
const char *trans, const int *ifunc, const int *m, const int *n, const char *trans, const blasint *ifunc, const blasint *m, const blasint *n,
const double *A, const int *ldA, const double *B, const int *ldB, const double *A, const blasint *ldA, const double *B, const blasint *ldB,
double *C, const int *ldC, double *C, const blasint *ldC,
const double *D, const int *ldD, const double *E, const int *ldE, const double *D, const blasint *ldD, const double *E, const blasint *ldE,
double *F, const int *ldF, double *F, const blasint *ldF,
double *scale, double *dsum, double *dscale, double *scale, double *dsum, double *dscale,
int *info blasint *info
) { ) {
if (*m <= MAX(CROSSOVER_ZTGSYL, 1) && *n <= MAX(CROSSOVER_ZTGSYL, 1)) { if (*m <= MAX(CROSSOVER_ZTGSYL, 1) && *n <= MAX(CROSSOVER_ZTGSYL, 1)) {
@ -137,18 +137,18 @@ static void RELAPACK_ztgsyl_rec(
// Constants // Constants
const double ONE[] = { 1., 0. }; const double ONE[] = { 1., 0. };
const double MONE[] = { -1., 0. }; const double MONE[] = { -1., 0. };
const int iONE[] = { 1 }; const blasint iONE[] = { 1 };
// Outputs // Outputs
double scale1[] = { 1., 0. }; double scale1[] = { 1., 0. };
double scale2[] = { 1., 0. }; double scale2[] = { 1., 0. };
int info1[] = { 0 }; blasint info1[] = { 0 };
int info2[] = { 0 }; blasint info2[] = { 0 };
if (*m > *n) { if (*m > *n) {
// Splitting // Splitting
const int m1 = ZREC_SPLIT(*m); const blasint m1 = ZREC_SPLIT(*m);
const int m2 = *m - m1; const blasint m2 = *m - m1;
// A_TL A_TR // A_TL A_TR
// 0 A_BR // 0 A_BR
@ -206,8 +206,8 @@ static void RELAPACK_ztgsyl_rec(
} }
} else { } else {
// Splitting // Splitting
const int n1 = ZREC_SPLIT(*n); const blasint n1 = ZREC_SPLIT(*n);
const int n2 = *n - n1; const blasint n2 = *n - n1;
// B_TL B_TR // B_TL B_TR
// 0 B_BR // 0 B_BR

52
relapack/src/ztrsyl.c
View File

@ -1,8 +1,8 @@
#include "relapack.h" #include "relapack.h"
static void RELAPACK_ztrsyl_rec(const char *, const char *, const int *, static void RELAPACK_ztrsyl_rec(const char *, const char *, const blasint *,
const int *, const int *, const double *, const int *, const double *, const blasint *, const blasint *, const double *, const blasint *, const double *,
const int *, double *, const int *, double *, int *); const blasint *, double *, const blasint *, double *, blasint *);
/** ZTRSYL solves the complex Sylvester matrix equation. /** ZTRSYL solves the complex Sylvester matrix equation.
@ -12,18 +12,18 @@ static void RELAPACK_ztrsyl_rec(const char *, const char *, const int *,
* http://www.netlib.org/lapack/explore-html/d1/d36/ztrsyl_8f.html * http://www.netlib.org/lapack/explore-html/d1/d36/ztrsyl_8f.html
* */ * */
void RELAPACK_ztrsyl( void RELAPACK_ztrsyl(
const char *tranA, const char *tranB, const int *isgn, const char *tranA, const char *tranB, const blasint *isgn,
const int *m, const int *n, const blasint *m, const blasint *n,
const double *A, const int *ldA, const double *B, const int *ldB, const double *A, const blasint *ldA, const double *B, const blasint *ldB,
double *C, const int *ldC, double *scale, double *C, const blasint *ldC, double *scale,
int *info blasint *info
) { ) {
// Check arguments // Check arguments
const int notransA = LAPACK(lsame)(tranA, "N"); const blasint notransA = LAPACK(lsame)(tranA, "N");
const int ctransA = LAPACK(lsame)(tranA, "C"); const blasint ctransA = LAPACK(lsame)(tranA, "C");
const int notransB = LAPACK(lsame)(tranB, "N"); const blasint notransB = LAPACK(lsame)(tranB, "N");
const int ctransB = LAPACK(lsame)(tranB, "C"); const blasint ctransB = LAPACK(lsame)(tranB, "C");
*info = 0; *info = 0;
if (!ctransA && !notransA) if (!ctransA && !notransA)
*info = -1; *info = -1;
@ -42,8 +42,8 @@ void RELAPACK_ztrsyl(
else if (*ldC < MAX(1, *m)) else if (*ldC < MAX(1, *m))
*info = -11; *info = -11;
if (*info) { if (*info) {
const int minfo = -*info; const blasint minfo = -*info;
LAPACK(xerbla)("ZTRSYL", &minfo); LAPACK(xerbla)("ZTRSYL", &minfo, strlen("ZTRSYL"));
return; return;
} }
@ -58,11 +58,11 @@ void RELAPACK_ztrsyl(
/** ztrsyl's recursive compute kernel */ /** ztrsyl's recursive compute kernel */
static void RELAPACK_ztrsyl_rec( static void RELAPACK_ztrsyl_rec(
const char *tranA, const char *tranB, const int *isgn, const char *tranA, const char *tranB, const blasint *isgn,
const int *m, const int *n, const blasint *m, const blasint *n,
const double *A, const int *ldA, const double *B, const int *ldB, const double *A, const blasint *ldA, const double *B, const blasint *ldB,
double *C, const int *ldC, double *scale, double *C, const blasint *ldC, double *scale,
int *info blasint *info
) { ) {
if (*m <= MAX(CROSSOVER_ZTRSYL, 1) && *n <= MAX(CROSSOVER_ZTRSYL, 1)) { if (*m <= MAX(CROSSOVER_ZTRSYL, 1) && *n <= MAX(CROSSOVER_ZTRSYL, 1)) {
@ -75,18 +75,18 @@ static void RELAPACK_ztrsyl_rec(
const double ONE[] = { 1., 0. }; const double ONE[] = { 1., 0. };
const double MONE[] = { -1., 0. }; const double MONE[] = { -1., 0. };
const double MSGN[] = { -*isgn, 0. }; const double MSGN[] = { -*isgn, 0. };
const int iONE[] = { 1 }; const blasint iONE[] = { 1 };
// Outputs // Outputs
double scale1[] = { 1., 0. }; double scale1[] = { 1., 0. };
double scale2[] = { 1., 0. }; double scale2[] = { 1., 0. };
int info1[] = { 0 }; blasint info1[] = { 0 };
int info2[] = { 0 }; blasint info2[] = { 0 };
if (*m > *n) { if (*m > *n) {
// Splitting // Splitting
const int m1 = ZREC_SPLIT(*m); const blasint m1 = ZREC_SPLIT(*m);
const int m2 = *m - m1; const blasint m2 = *m - m1;
// A_TL A_TR // A_TL A_TR
// 0 A_BR // 0 A_BR
@ -122,8 +122,8 @@ static void RELAPACK_ztrsyl_rec(
} }
} else { } else {
// Splitting // Splitting
const int n1 = ZREC_SPLIT(*n); const blasint n1 = ZREC_SPLIT(*n);
const int n2 = *n - n1; const blasint n2 = *n - n1;
// B_TL B_TR // B_TL B_TR
// 0 B_BR // 0 B_BR

42
relapack/src/ztrsyl_rec2.c
View File

@ -14,16 +14,16 @@
#include "f2c.h" #include "f2c.h"
#if BLAS_COMPLEX_FUNCTIONS_AS_ROUTINES #if BLAS_COMPLEX_FUNCTIONS_AS_ROUTINES
doublecomplex zdotu_fun(int *n, doublecomplex *x, int *incx, doublecomplex *y, int *incy) { doublecomplex zdotu_fun(int *n, doublecomplex *x, blasint *incx, doublecomplex *y, blasint *incy) {
extern void zdotu_(doublecomplex *, int *, doublecomplex *, int *, doublecomplex *, int *); extern void zdotu_(doublecomplex *, blasint *, doublecomplex *, blasint *, doublecomplex *, blasint *);
doublecomplex result; doublecomplex result;
zdotu_(&result, n, x, incx, y, incy); zdotu_(&result, n, x, incx, y, incy);
return result; return result;
} }
#define zdotu_ zdotu_fun #define zdotu_ zdotu_fun
doublecomplex zdotc_fun(int *n, doublecomplex *x, int *incx, doublecomplex *y, int *incy) { doublecomplex zdotc_fun(int *n, doublecomplex *x, blasint *incx, doublecomplex *y, blasint *incy) {
extern void zdotc_(doublecomplex *, int *, doublecomplex *, int *, doublecomplex *, int *); extern void zdotc_(doublecomplex *, blasint *, doublecomplex *, blasint *, doublecomplex *, blasint *);
doublecomplex result; doublecomplex result;
zdotc_(&result, n, x, incx, y, incy); zdotc_(&result, n, x, incx, y, incy);
return result; return result;
@ -43,7 +43,7 @@ doublecomplex zladiv_fun(doublecomplex *a, doublecomplex *b) {
/* Table of constant values */ /* Table of constant values */
static int c__1 = 1; static blasint c__1 = 1;
/** RELAPACK_ZTRSYL_REC2 solves the complex Sylvester matrix equation (unblocked algorithm) /** RELAPACK_ZTRSYL_REC2 solves the complex Sylvester matrix equation (unblocked algorithm)
* *
@ -51,12 +51,12 @@ static int c__1 = 1;
* It serves as an unblocked kernel in the recursive algorithms. * It serves as an unblocked kernel in the recursive algorithms.
* */ * */
/* Subroutine */ void RELAPACK_ztrsyl_rec2(char *trana, char *tranb, int /* Subroutine */ void RELAPACK_ztrsyl_rec2(char *trana, char *tranb, int
*isgn, int *m, int *n, doublecomplex *a, int *lda, *isgn, blasint *m, blasint *n, doublecomplex *a, blasint *lda,
doublecomplex *b, int *ldb, doublecomplex *c__, int *ldc, doublecomplex *b, blasint *ldb, doublecomplex *c__, blasint *ldc,
double *scale, int *info, ftnlen trana_len, ftnlen tranb_len) double *scale, blasint *info, ftnlen trana_len, ftnlen tranb_len)
{ {
/* System generated locals */ /* System generated locals */
int a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2, blasint a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2,
i__3, i__4; i__3, i__4;
double d__1, d__2; double d__1, d__2;
doublecomplex z__1, z__2, z__3, z__4; doublecomplex z__1, z__2, z__3, z__4;
@ -66,7 +66,7 @@ static int c__1 = 1;
void d_cnjg(doublecomplex *, doublecomplex *); void d_cnjg(doublecomplex *, doublecomplex *);
/* Local variables */ /* Local variables */
static int j, k, l; static blasint j, k, l;
static doublecomplex a11; static doublecomplex a11;
static double db; static double db;
static doublecomplex x11; static doublecomplex x11;
@ -74,23 +74,23 @@ static int c__1 = 1;
static doublecomplex vec; static doublecomplex vec;
static double dum[1], eps, sgn, smin; static double dum[1], eps, sgn, smin;
static doublecomplex suml, sumr; static doublecomplex suml, sumr;
extern int lsame_(char *, char *, ftnlen, ftnlen); extern blasint lsame_(char *, char *, ftnlen, ftnlen);
/* Double Complex */ doublecomplex zdotc_(int *, /* Double Complex */ doublecomplex zdotc_(int *,
doublecomplex *, int *, doublecomplex *, int *), zdotu_( doublecomplex *, blasint *, doublecomplex *, blasint *), zdotu_(
int *, doublecomplex *, int *, blasint *, doublecomplex *, blasint *,
doublecomplex *, int *); doublecomplex *, blasint *);
extern /* Subroutine */ int dlabad_(double *, double *); extern /* Subroutine */ blasint dlabad_(double *, double *);
extern double dlamch_(char *, ftnlen); extern double dlamch_(char *, ftnlen);
static double scaloc; static double scaloc;
extern /* Subroutine */ int xerbla_(char *, int *, ftnlen); extern /* Subroutine */ blasint xerbla_(char *, blasint *, ftnlen);
extern double zlange_(char *, int *, int *, doublecomplex *, extern double zlange_(char *, blasint *, blasint *, doublecomplex *,
int *, double *, ftnlen); blasint *, double *, ftnlen);
static double bignum; static double bignum;
extern /* Subroutine */ int zdscal_(int *, double *, extern /* Subroutine */ blasint zdscal_(int *, double *,
doublecomplex *, int *); doublecomplex *, blasint *);
/* Double Complex */ doublecomplex zladiv_(doublecomplex *, /* Double Complex */ doublecomplex zladiv_(doublecomplex *,
doublecomplex *); doublecomplex *);
static int notrna, notrnb; static blasint notrna, notrnb;
static double smlnum; static double smlnum;
/* Parameter adjustments */ /* Parameter adjustments */

34
relapack/src/ztrtri.c
View File

@ -1,7 +1,7 @@
#include "relapack.h" #include "relapack.h"
static void RELAPACK_ztrtri_rec(const char *, const char *, const int *, static void RELAPACK_ztrtri_rec(const char *, const char *, const blasint *,
double *, const int *, int *); double *, const blasint *, blasint *);
/** CTRTRI computes the inverse of a complex upper or lower triangular matrix A. /** CTRTRI computes the inverse of a complex upper or lower triangular matrix A.
@ -11,16 +11,16 @@ static void RELAPACK_ztrtri_rec(const char *, const char *, const int *,
* http://www.netlib.org/lapack/explore-html/d1/d0e/ztrtri_8f.html * http://www.netlib.org/lapack/explore-html/d1/d0e/ztrtri_8f.html
* */ * */
void RELAPACK_ztrtri( void RELAPACK_ztrtri(
const char *uplo, const char *diag, const int *n, const char *uplo, const char *diag, const blasint *n,
double *A, const int *ldA, double *A, const blasint *ldA,
int *info blasint *info
) { ) {
// Check arguments // Check arguments
const int lower = LAPACK(lsame)(uplo, "L"); const blasint lower = LAPACK(lsame)(uplo, "L");
const int upper = LAPACK(lsame)(uplo, "U"); const blasint upper = LAPACK(lsame)(uplo, "U");
const int nounit = LAPACK(lsame)(diag, "N"); const blasint nounit = LAPACK(lsame)(diag, "N");
const int unit = LAPACK(lsame)(diag, "U"); const blasint unit = LAPACK(lsame)(diag, "U");
*info = 0; *info = 0;
if (!lower && !upper) if (!lower && !upper)
*info = -1; *info = -1;
@ -31,8 +31,8 @@ void RELAPACK_ztrtri(
else if (*ldA < MAX(1, *n)) else if (*ldA < MAX(1, *n))
*info = -5; *info = -5;
if (*info) { if (*info) {
const int minfo = -*info; const blasint minfo = -*info;
LAPACK(xerbla)("ZTRTRI", &minfo); LAPACK(xerbla)("ZTRTRI", &minfo, strlen("ZTRTRI"));
return; return;
} }
@ -42,7 +42,7 @@ void RELAPACK_ztrtri(
// check for singularity // check for singularity
if (nounit) { if (nounit) {
int i; blasint i;
for (i = 0; i < *n; i++) for (i = 0; i < *n; i++)
if (A[2 * (i + *ldA * i)] == 0 && A[2 * (i + *ldA * i) + 1] == 0) { if (A[2 * (i + *ldA * i)] == 0 && A[2 * (i + *ldA * i) + 1] == 0) {
*info = i; *info = i;
@ -57,9 +57,9 @@ void RELAPACK_ztrtri(
/** ztrtri's recursive compute kernel */ /** ztrtri's recursive compute kernel */
static void RELAPACK_ztrtri_rec( static void RELAPACK_ztrtri_rec(
const char *uplo, const char *diag, const int *n, const char *uplo, const char *diag, const blasint *n,
double *A, const int *ldA, double *A, const blasint *ldA,
int *info blasint *info
){ ){
if (*n <= MAX(CROSSOVER_ZTRTRI, 1)) { if (*n <= MAX(CROSSOVER_ZTRTRI, 1)) {
@ -73,8 +73,8 @@ static void RELAPACK_ztrtri_rec(
const double MONE[] = { -1. }; const double MONE[] = { -1. };
// Splitting // Splitting
const int n1 = ZREC_SPLIT(*n); const blasint n1 = ZREC_SPLIT(*n);
const int n2 = *n - n1; const blasint n2 = *n - n1;
// A_TL A_TR // A_TL A_TR
// A_BL A_BR // A_BL A_BR