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
#define BLAS_H
extern void BLAS(sswap)(const int *, float *, const int *, float *, const int *);
extern void BLAS(dswap)(const int *, double *, const int *, double *, const int *);
extern void BLAS(cswap)(const int *, float *, const int *, float *, const int *);
extern void BLAS(zswap)(const int *, double *, const int *, double *, const int *);
extern void BLAS(sswap)(const blasint *, float *, const blasint *, float *, const blasint *);
extern void BLAS(dswap)(const blasint *, double *, const blasint *, double *, const blasint *);
extern void BLAS(cswap)(const blasint *, float *, const blasint *, float *, const blasint *);
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(dscal)(const int *, const double *, double *, const int *);
extern void BLAS(cscal)(const int *, const float *, float *, const int *);
extern void BLAS(zscal)(const int *, const double *, double *, const int *);
extern void BLAS(sscal)(const blasint *, const float *, float *, const blasint *);
extern void BLAS(dscal)(const blasint *, const double *, double *, const blasint *);
extern void BLAS(cscal)(const blasint *, const float *, float *, const blasint *);
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(daxpy)(const int *, const double *, const double *, const int *, double *, const int *);
extern void BLAS(caxpy)(const int *, const float *, const float *, const int *, float *, const int *);
extern void BLAS(zaxpy)(const int *, const double *, const double *, const int *, double *, const int *);
extern void BLAS(saxpy)(const blasint *, const float *, const float *, const blasint *, float *, const blasint *);
extern void BLAS(daxpy)(const blasint *, const double *, const double *, const blasint *, double *, const blasint *);
extern void BLAS(caxpy)(const blasint *, const float *, const float *, const blasint *, float *, const blasint *);
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(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(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(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(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 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 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 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(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(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(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(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 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 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 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(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(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(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(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 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 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 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(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(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(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(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 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 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 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(dsyrk)(const char *, const char *, const int *, const int *, const double *, double *, const int *, const double *, double *, const int *);
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(zherk)(const char *, const char *, const int *, const int *, const double *, double *, const int *, const double *, double *, 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 blasint *, const blasint *, const double *, double *, const blasint *, const double *, double *, const blasint *);
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 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(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(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(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(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 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 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 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(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(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(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(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 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 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 blasint *, const blasint *, const double *, const double *, const blasint *, const double *, const blasint *, const double *, double *, const blasint *);
#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(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(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(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(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 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 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 blasint *, const blasint *, const double *, const double *, const blasint *, const double *, const blasint *, const double *, const double *, const blasint*);
#endif
#endif /* BLAS_H */

78
relapack/src/cgbtrf.c
View File

@ -1,9 +1,9 @@
#include "relapack.h"
#include "stdlib.h"
static void RELAPACK_cgbtrf_rec(const int *, const int *, const int *,
const int *, float *, const int *, int *, float *, const int *, float *,
const int *, int *);
static void RELAPACK_cgbtrf_rec(const blasint *, const blasint *, const blasint *,
const blasint *, float *, const blasint *, blasint *, float *, const blasint *, float *,
const blasint *, blasint *);
/** 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
* */
void RELAPACK_cgbtrf(
const int *m, const int *n, const int *kl, const int *ku,
float *Ab, const int *ldAb, int *ipiv,
int *info
const blasint *m, const blasint *n, const blasint *kl, const blasint *ku,
float *Ab, const blasint *ldAb, blasint *ipiv,
blasint *info
) {
// Check arguments
@ -31,8 +31,8 @@ void RELAPACK_cgbtrf(
else if (*ldAb < 2 * *kl + *ku + 1)
*info = -6;
if (*info) {
const int minfo = -*info;
LAPACK(xerbla)("CGBTRF", &minfo);
const blasint minfo = -*info;
LAPACK(xerbla)("CGBTRF", &minfo, strlen("CGBTRF"));
return;
}
@ -40,14 +40,14 @@ void RELAPACK_cgbtrf(
const float ZERO[] = { 0., 0. };
// Result upper band width
const int kv = *ku + *kl;
const blasint kv = *ku + *kl;
// Unskew A
const int ldA[] = { *ldAb - 1 };
const blasint ldA[] = { *ldAb - 1 };
float *const A = Ab + 2 * kv;
// Zero upper diagonal fill-in elements
int i, j;
blasint i, j;
for (j = 0; j < *n; j++) {
float *const A_j = A + 2 * *ldA * j;
for (i = MAX(0, j - kv); i < j - *ku; i++)
@ -55,11 +55,11 @@ void RELAPACK_cgbtrf(
}
// Allocate work space
const int n1 = CREC_SPLIT(*n);
const int mWorkl = (kv > n1) ? MAX(1, *m - *kl) : kv;
const int nWorkl = (kv > n1) ? n1 : kv;
const int mWorku = (*kl > n1) ? n1 : *kl;
const int nWorku = (*kl > n1) ? MAX(0, *n - *kl) : *kl;
const blasint n1 = CREC_SPLIT(*n);
const blasint mWorkl = (kv > n1) ? MAX(1, *m - *kl) : kv;
const blasint nWorkl = (kv > n1) ? n1 : kv;
const blasint mWorku = (*kl > n1) ? n1 : *kl;
const blasint nWorku = (*kl > n1) ? MAX(0, *n - *kl) : *kl;
float *Workl = malloc(mWorkl * nWorkl * 2 * sizeof(float));
float *Worku = malloc(mWorku * nWorku * 2 * sizeof(float));
LAPACK(claset)("L", &mWorkl, &nWorkl, ZERO, ZERO, Workl, &mWorkl);
@ -76,10 +76,10 @@ void RELAPACK_cgbtrf(
/** cgbtrf's recursive compute kernel */
static void RELAPACK_cgbtrf_rec(
const int *m, const int *n, const int *kl, const int *ku,
float *Ab, const int *ldAb, int *ipiv,
float *Workl, const int *ldWorkl, float *Worku, const int *ldWorku,
int *info
const blasint *m, const blasint *n, const blasint *kl, const blasint *ku,
float *Ab, const blasint *ldAb, blasint *ipiv,
float *Workl, const blasint *ldWorkl, float *Worku, const blasint *ldWorku,
blasint *info
) {
if (*n <= MAX(CROSSOVER_CGBTRF, 1)) {
@ -91,25 +91,25 @@ static void RELAPACK_cgbtrf_rec(
// Constants
const float ONE[] = { 1., 0. };
const float MONE[] = { -1., 0. };
const int iONE[] = { 1 };
const blasint iONE[] = { 1 };
// Loop iterators
int i, j;
blasint i, j;
// Output upper band width
const int kv = *ku + *kl;
const blasint kv = *ku + *kl;
// Unskew A
const int ldA[] = { *ldAb - 1 };
const blasint ldA[] = { *ldAb - 1 };
float *const A = Ab + 2 * kv;
// Splitting
const int n1 = MIN(CREC_SPLIT(*n), *kl);
const int n2 = *n - n1;
const int m1 = MIN(n1, *m);
const int m2 = *m - m1;
const int mn1 = MIN(m1, n1);
const int mn2 = MIN(m2, n2);
const blasint n1 = MIN(CREC_SPLIT(*n), *kl);
const blasint n2 = *n - n1;
const blasint m1 = MIN(n1, *m);
const blasint m2 = *m - m1;
const blasint mn1 = MIN(m1, n1);
const blasint mn2 = MIN(m2, n2);
// Ab_L *
// Ab_BR
@ -129,14 +129,14 @@ static void RELAPACK_cgbtrf_rec(
// ipiv_T
// ipiv_B
int *const ipiv_T = ipiv;
int *const ipiv_B = ipiv + n1;
blasint *const ipiv_T = ipiv;
blasint *const ipiv_B = ipiv + n1;
// Banded splitting
const int n21 = MIN(n2, kv - n1);
const int n22 = MIN(n2 - n21, n1);
const int m21 = MIN(m2, *kl - m1);
const int m22 = MIN(m2 - m21, m1);
const blasint n21 = MIN(n2, kv - n1);
const blasint n22 = MIN(n2 - n21, n1);
const blasint m21 = MIN(m2, *kl - m1);
const blasint m22 = MIN(m2 - m21, m1);
// n1 n21 n22
// m * A_Rl ARr
@ -164,7 +164,7 @@ static void RELAPACK_cgbtrf_rec(
// partially redo swaps in A_L
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 < *kl)
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++) {
float *const A_Rrj = A_Rr + 2 * *ldA * j;
for (i = j; i < mn1; i++) {
const int ip = ipiv_T[i] - 1;
const blasint ip = ipiv_T[i] - 1;
if (ip != i) {
const float tmpr = A_Rrj[2 * i];
const float tmpc = A_Rrj[2 * i + 1];
@ -211,7 +211,7 @@ static void RELAPACK_cgbtrf_rec(
// partially undo swaps in A_L
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 < *kl)
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"
static void RELAPACK_cgemmt_rec(const char *, const char *, const char *,
const int *, const int *, const float *, const float *, const int *,
const float *, const int *, const float *, float *, const int *);
const blasint *, const blasint *, const float *, const float *, const blasint *,
const float *, const blasint *, const float *, float *, const blasint *);
static void RELAPACK_cgemmt_rec2(const char *, const char *, const char *,
const int *, const int *, const float *, const float *, const int *,
const float *, const int *, const float *, float *, const int *);
const blasint *, const blasint *, const float *, const float *, const blasint *,
const float *, const blasint *, const float *, float *, const blasint *);
/** 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(
const char *uplo, const char *transA, const char *transB,
const int *n, const int *k,
const float *alpha, const float *A, const int *ldA,
const float *B, const int *ldB,
const float *beta, float *C, const int *ldC
const blasint *n, const blasint *k,
const float *alpha, const float *A, const blasint *ldA,
const float *B, const blasint *ldB,
const float *beta, float *C, const blasint *ldC
) {
#if HAVE_XGEMMT
@ -32,15 +32,15 @@ void RELAPACK_cgemmt(
#else
// Check arguments
const int lower = LAPACK(lsame)(uplo, "L");
const int upper = LAPACK(lsame)(uplo, "U");
const int notransA = LAPACK(lsame)(transA, "N");
const int tranA = LAPACK(lsame)(transA, "T");
const int ctransA = LAPACK(lsame)(transA, "C");
const int notransB = LAPACK(lsame)(transB, "N");
const int tranB = LAPACK(lsame)(transB, "T");
const int ctransB = LAPACK(lsame)(transB, "C");
int info = 0;
const blasint lower = LAPACK(lsame)(uplo, "L");
const blasint upper = LAPACK(lsame)(uplo, "U");
const blasint notransA = LAPACK(lsame)(transA, "N");
const blasint tranA = LAPACK(lsame)(transA, "T");
const blasint ctransA = LAPACK(lsame)(transA, "C");
const blasint notransB = LAPACK(lsame)(transB, "N");
const blasint tranB = LAPACK(lsame)(transB, "T");
const blasint ctransB = LAPACK(lsame)(transB, "C");
blasint info = 0;
if (!lower && !upper)
info = 1;
else if (!tranA && !ctransA && !notransA)
@ -58,7 +58,7 @@ void RELAPACK_cgemmt(
else if (*ldC < MAX(1, *n))
info = 13;
if (info) {
LAPACK(xerbla)("CGEMMT", &info);
LAPACK(xerbla)("CGEMMT", &info, strlen("CGEMMT"));
return;
}
@ -76,10 +76,10 @@ void RELAPACK_cgemmt(
/** cgemmt's recursive compute kernel */
static void RELAPACK_cgemmt_rec(
const char *uplo, const char *transA, const char *transB,
const int *n, const int *k,
const float *alpha, const float *A, const int *ldA,
const float *B, const int *ldB,
const float *beta, float *C, const int *ldC
const blasint *n, const blasint *k,
const float *alpha, const float *A, const blasint *ldA,
const float *B, const blasint *ldB,
const float *beta, float *C, const blasint *ldC
) {
if (*n <= MAX(CROSSOVER_CGEMMT, 1)) {
@ -89,8 +89,8 @@ static void RELAPACK_cgemmt_rec(
}
// Splitting
const int n1 = CREC_SPLIT(*n);
const int n2 = *n - n1;
const blasint n1 = CREC_SPLIT(*n);
const blasint n2 = *n - n1;
// A_T
// A_B
@ -126,16 +126,16 @@ static void RELAPACK_cgemmt_rec(
/** cgemmt's unblocked compute kernel */
static void RELAPACK_cgemmt_rec2(
const char *uplo, const char *transA, const char *transB,
const int *n, const int *k,
const float *alpha, const float *A, const int *ldA,
const float *B, const int *ldB,
const float *beta, float *C, const int *ldC
const blasint *n, const blasint *k,
const float *alpha, const float *A, const blasint *ldA,
const float *B, const blasint *ldB,
const float *beta, float *C, const blasint *ldC
) {
const int incB = (*transB == 'N') ? 1 : *ldB;
const int incC = 1;
const blasint incB = (*transB == 'N') ? 1 : *ldB;
const blasint incC = 1;
int i;
blasint i;
for (i = 0; i < *n; i++) {
// A_0
// A_i
@ -151,13 +151,13 @@ static void RELAPACK_cgemmt_rec2(
float *const C_ii = C + 2 * *ldC * i + 2 * i;
if (*uplo == 'L') {
const int nmi = *n - i;
const blasint nmi = *n - i;
if (*transA == 'N')
BLAS(cgemv)(transA, &nmi, k, alpha, A_i, ldA, B_i, &incB, beta, C_ii, &incC);
else
BLAS(cgemv)(transA, k, &nmi, alpha, A_i, ldA, B_i, &incB, beta, C_ii, &incC);
} else {
const int ip1 = i + 1;
const blasint ip1 = i + 1;
if (*transA == 'N')
BLAS(cgemv)(transA, &ip1, k, alpha, A_0, ldA, B_i, &incB, beta, C_0i, &incC);
else

40
relapack/src/cgetrf.c
View File

@ -1,7 +1,7 @@
#include "relapack.h"
static void RELAPACK_cgetrf_rec(const int *, const int *, float *,
const int *, int *, int *);
static void RELAPACK_cgetrf_rec(const blasint *, const blasint *, float *,
const blasint *, blasint *, blasint *);
/** 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
*/
void RELAPACK_cgetrf(
const int *m, const int *n,
float *A, const int *ldA, int *ipiv,
int *info
const blasint *m, const blasint *n,
float *A, const blasint *ldA, blasint *ipiv,
blasint *info
) {
// Check arguments
@ -25,12 +25,12 @@ void RELAPACK_cgetrf(
else if (*ldA < MAX(1, *n))
*info = -4;
if (*info) {
const int minfo = -*info;
LAPACK(xerbla)("CGETRF", &minfo);
const blasint minfo = -*info;
LAPACK(xerbla)("CGETRF", &minfo, strlen("CGETRF"));
return;
}
const int sn = MIN(*m, *n);
const blasint sn = MIN(*m, *n);
RELAPACK_cgetrf_rec(m, &sn, A, ldA, ipiv, info);
@ -38,10 +38,10 @@ void RELAPACK_cgetrf(
if (*m < *n) {
// Constants
const float ONE[] = { 1., 0. };
const int iONE[] = { 1 };
const blasint iONE[] = { 1 };
// Splitting
const int rn = *n - *m;
const blasint rn = *n - *m;
// A_L A_R
const float *const A_L = A;
@ -57,9 +57,9 @@ void RELAPACK_cgetrf(
/** cgetrf's recursive compute kernel */
static void RELAPACK_cgetrf_rec(
const int *m, const int *n,
float *A, const int *ldA, int *ipiv,
int *info
const blasint *m, const blasint *n,
float *A, const blasint *ldA, blasint *ipiv,
blasint *info
) {
if (*n <= MAX(CROSSOVER_CGETRF, 1)) {
@ -71,12 +71,12 @@ static void RELAPACK_cgetrf_rec(
// Constants
const float ONE[] = { 1., 0. };
const float MONE[] = { -1., 0. };
const int iONE[] = { 1 };
const blasint iONE[] = { 1 };
// Splitting
const int n1 = CREC_SPLIT(*n);
const int n2 = *n - n1;
const int m2 = *m - n1;
const blasint n1 = CREC_SPLIT(*n);
const blasint n2 = *n - n1;
const blasint m2 = *m - n1;
// A_L A_R
float *const A_L = A;
@ -91,8 +91,8 @@ static void RELAPACK_cgetrf_rec(
// ipiv_T
// ipiv_B
int *const ipiv_T = ipiv;
int *const ipiv_B = ipiv + n1;
blasint *const ipiv_T = ipiv;
blasint *const ipiv_B = ipiv + n1;
// recursion(A_L, ipiv_T)
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
LAPACK(claswp)(&n1, A_BL, ldA, iONE, &n2, ipiv_B, iONE);
// shift pivots
int i;
blasint i;
for (i = 0; i < n2; i++)
ipiv_B[i] += n1;
}

38
relapack/src/chegst.c
View File

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

72
relapack/src/chetrf.c
View File

@ -3,8 +3,8 @@
#include <stdlib.h>
#endif
static void RELAPACK_chetrf_rec(const char *, const int *, const int *, int *,
float *, const int *, int *, float *, const int *, int *);
static void RELAPACK_chetrf_rec(const char *, const blasint *, const blasint *, blasint *,
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.
@ -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
* */
void RELAPACK_chetrf(
const char *uplo, const int *n,
float *A, const int *ldA, int *ipiv,
float *Work, const int *lWork, int *info
const char *uplo, const blasint *n,
float *A, const blasint *ldA, blasint *ipiv,
float *Work, const blasint *lWork, blasint *info
) {
// Required work size
const int cleanlWork = *n * (*n / 2);
int minlWork = cleanlWork;
const blasint cleanlWork = *n * (*n / 2);
blasint minlWork = cleanlWork;
#if XSYTRF_ALLOW_MALLOC
minlWork = 1;
#endif
// Check arguments
const int lower = LAPACK(lsame)(uplo, "L");
const int upper = LAPACK(lsame)(uplo, "U");
const blasint lower = LAPACK(lsame)(uplo, "L");
const blasint upper = LAPACK(lsame)(uplo, "U");
*info = 0;
if (!lower && !upper)
*info = -1;
@ -55,8 +55,8 @@ void RELAPACK_chetrf(
#endif
if (*info) {
const int minfo = -*info;
LAPACK(xerbla)("CHETRF", &minfo);
const blasint minfo = -*info;
LAPACK(xerbla)("CHETRF", &minfo, strlen("CHETRF"));
return;
}
@ -64,7 +64,7 @@ void RELAPACK_chetrf(
const char cleanuplo = lower ? 'L' : 'U';
// Dummy argument
int nout;
blasint nout;
// Recursive kernel
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 */
static void RELAPACK_chetrf_rec(
const char *uplo, const int *n_full, const int *n, int *n_out,
float *A, const int *ldA, int *ipiv,
float *Work, const int *ldWork, int *info
const char *uplo, const blasint *n_full, const blasint *n, blasint *n_out,
float *A, const blasint *ldA, blasint *ipiv,
float *Work, const blasint *ldWork, blasint *info
) {
// top recursion level?
const int top = *n_full == *n;
const blasint top = *n_full == *n;
if (*n <= MAX(CROSSOVER_CHETRF, 3)) {
// Unblocked
@ -96,31 +96,31 @@ static void RELAPACK_chetrf_rec(
return;
}
int info1, info2;
blasint info1, info2;
// Constants
const float ONE[] = { 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') {
// Splitting (setup)
int n1 = CREC_SPLIT(*n);
int n2 = *n - n1;
blasint n1 = CREC_SPLIT(*n);
blasint n2 = *n - n1;
// Work_L *
float *const Work_L = Work;
// 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);
n1 = n1_out;
// Splitting (continued)
n2 = *n - n1;
const int n_full2 = *n_full - n1;
const blasint n_full2 = *n_full - n1;
// * *
// A_BL A_BR
@ -136,23 +136,23 @@ static void RELAPACK_chetrf_rec(
// (top recursion level: use Work as Work_BR)
float *const Work_BL = Work + 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_B
int *const ipiv_B = ipiv + n1;
blasint *const ipiv_B = ipiv + n1;
// 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);
BLAS(cgemm)("N", "T", &n_rest, &n2, &n1, MONE, A_BL_B, ldA, Work_BL, ldWork, ONE, A_BR_B, ldA);
// 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);
if (n2_out != n2) {
// undo 1 column of updates
const int n_restp1 = n_rest + 1;
const blasint n_restp1 = n_rest + 1;
// last column of A_BR
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;
// shift pivots
int i;
blasint i;
for (i = 0; i < n2; i++)
if (ipiv_B[i] > 0)
ipiv_B[i] += n1;
@ -180,22 +180,22 @@ static void RELAPACK_chetrf_rec(
*n_out = n1 + n2;
} else {
// Splitting (setup)
int n2 = CREC_SPLIT(*n);
int n1 = *n - n2;
blasint n2 = CREC_SPLIT(*n);
blasint n1 = *n - n2;
// * Work_R
// (top recursion level: use Work as Work_R)
float *const Work_R = top ? Work : Work + 2 * *ldWork * n1;
// 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);
const int n2_diff = n2 - n2_out;
const blasint n2_diff = n2 - n2_out;
n2 = n2_out;
// Splitting (continued)
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 A_TR
@ -211,19 +211,19 @@ static void RELAPACK_chetrf_rec(
// (top recursion level: Work_R was Work)
float *const Work_L = Work;
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'
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);
// 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);
if (n1_out != n1) {
// 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'
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 */
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
*
@ -24,12 +24,12 @@ static int c__1 = 1;
* The blocked BLAS Level 3 updates were removed and moved to the
* recursive algorithm.
* */
/* Subroutine */ void RELAPACK_chetrf_rec2(char *uplo, int *n, int *
nb, int *kb, complex *a, int *lda, int *ipiv, complex *w,
int *ldw, int *info, ftnlen uplo_len)
/* Subroutine */ void RELAPACK_chetrf_rec2(char *uplo, blasint *n, blasint *
nb, blasint *kb, complex *a, blasint *lda, blasint *ipiv, complex *w,
int *ldw, blasint *info, ftnlen uplo_len)
{
/* 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;
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 *);
/* Local variables */
static int j, k;
static blasint j, k;
static float t, r1;
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;
extern logical lsame_(char *, char *, ftnlen, ftnlen);
extern /* Subroutine */ int cgemv_(char *, int *, int *, complex *
, complex *, int *, complex *, int *, complex *, complex *
, int *, ftnlen), ccopy_(int *, complex *, int *,
complex *, int *), cswap_(int *, complex *, int *,
complex *, int *);
static int kstep;
extern /* Subroutine */ blasint cgemv_(char *, blasint *, blasint *, complex *
, complex *, blasint *, complex *, blasint *, complex *, complex *
, blasint *, ftnlen), ccopy_(int *, complex *, blasint *,
complex *, blasint *), cswap_(int *, complex *, blasint *,
complex *, blasint *);
static blasint kstep;
static float absakk;
extern /* Subroutine */ int clacgv_(int *, complex *, int *);
extern int icamax_(int *, complex *, int *);
extern /* Subroutine */ int csscal_(int *, float *, complex *, int
extern /* Subroutine */ blasint clacgv_(int *, complex *, blasint *);
extern blasint icamax_(int *, complex *, blasint *);
extern /* Subroutine */ blasint csscal_(int *, float *, complex *, int
*);
static float colmax, rowmax;

72
relapack/src/chetrf_rook.c
View File

@ -3,8 +3,8 @@
#include <stdlib.h>
#endif
static void RELAPACK_chetrf_rook_rec(const char *, const int *, const int *, int *,
float *, const int *, int *, float *, const int *, int *);
static void RELAPACK_chetrf_rook_rec(const char *, const blasint *, const blasint *, blasint *,
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.
@ -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
* */
void RELAPACK_chetrf_rook(
const char *uplo, const int *n,
float *A, const int *ldA, int *ipiv,
float *Work, const int *lWork, int *info
const char *uplo, const blasint *n,
float *A, const blasint *ldA, blasint *ipiv,
float *Work, const blasint *lWork, blasint *info
) {
// Required work size
const int cleanlWork = *n * (*n / 2);
int minlWork = cleanlWork;
const blasint cleanlWork = *n * (*n / 2);
blasint minlWork = cleanlWork;
#if XSYTRF_ALLOW_MALLOC
minlWork = 1;
#endif
// Check arguments
const int lower = LAPACK(lsame)(uplo, "L");
const int upper = LAPACK(lsame)(uplo, "U");
const blasint lower = LAPACK(lsame)(uplo, "L");
const blasint upper = LAPACK(lsame)(uplo, "U");
*info = 0;
if (!lower && !upper)
*info = -1;
@ -55,8 +55,8 @@ void RELAPACK_chetrf_rook(
#endif
if (*info) {
const int minfo = -*info;
LAPACK(xerbla)("CHETRF", &minfo);
const blasint minfo = -*info;
LAPACK(xerbla)("CHETRF", &minfo, strlen("CHETRF"));
return;
}
@ -64,7 +64,7 @@ void RELAPACK_chetrf_rook(
const char cleanuplo = lower ? 'L' : 'U';
// Dummy argument
int nout;
blasint nout;
// Recursive kernel
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 */
static void RELAPACK_chetrf_rook_rec(
const char *uplo, const int *n_full, const int *n, int *n_out,
float *A, const int *ldA, int *ipiv,
float *Work, const int *ldWork, int *info
const char *uplo, const blasint *n_full, const blasint *n, blasint *n_out,
float *A, const blasint *ldA, blasint *ipiv,
float *Work, const blasint *ldWork, blasint *info
) {
// top recursion level?
const int top = *n_full == *n;
const blasint top = *n_full == *n;
if (*n <= MAX(CROSSOVER_CHETRF, 3)) {
// Unblocked
@ -96,31 +96,31 @@ static void RELAPACK_chetrf_rook_rec(
return;
}
int info1, info2;
blasint info1, info2;
// Constants
const float ONE[] = { 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') {
// Splitting (setup)
int n1 = CREC_SPLIT(*n);
int n2 = *n - n1;
blasint n1 = CREC_SPLIT(*n);
blasint n2 = *n - n1;
// Work_L *
float *const Work_L = Work;
// 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);
n1 = n1_out;
// Splitting (continued)
n2 = *n - n1;
const int n_full2 = *n_full - n1;
const blasint n_full2 = *n_full - n1;
// * *
// A_BL A_BR
@ -136,23 +136,23 @@ static void RELAPACK_chetrf_rook_rec(
// (top recursion level: use Work as Work_BR)
float *const Work_BL = Work + 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_B
int *const ipiv_B = ipiv + n1;
blasint *const ipiv_B = ipiv + n1;
// 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);
BLAS(cgemm)("N", "T", &n_rest, &n2, &n1, MONE, A_BL_B, ldA, Work_BL, ldWork, ONE, A_BR_B, ldA);
// 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);
if (n2_out != n2) {
// undo 1 column of updates
const int n_restp1 = n_rest + 1;
const blasint n_restp1 = n_rest + 1;
// last column of A_BR
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;
// shift pivots
int i;
blasint i;
for (i = 0; i < n2; i++)
if (ipiv_B[i] > 0)
ipiv_B[i] += n1;
@ -180,22 +180,22 @@ static void RELAPACK_chetrf_rook_rec(
*n_out = n1 + n2;
} else {
// Splitting (setup)
int n2 = CREC_SPLIT(*n);
int n1 = *n - n2;
blasint n2 = CREC_SPLIT(*n);
blasint n1 = *n - n2;
// * Work_R
// (top recursion level: use Work as Work_R)
float *const Work_R = top ? Work : Work + 2 * *ldWork * n1;
// 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);
const int n2_diff = n2 - n2_out;
const blasint n2_diff = n2 - n2_out;
n2 = n2_out;
// Splitting (continued)
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 A_TR
@ -211,19 +211,19 @@ static void RELAPACK_chetrf_rook_rec(
// (top recursion level: Work_R was Work)
float *const Work_L = Work;
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'
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);
// 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);
if (n1_out != n1) {
// 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'
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 */
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
*
@ -24,12 +24,12 @@ static int c__1 = 1;
* The blocked BLAS Level 3 updates were removed and moved to the
* recursive algorithm.
* */
/* Subroutine */ void RELAPACK_chetrf_rook_rec2(char *uplo, int *n,
int *nb, int *kb, complex *a, int *lda, int *ipiv,
complex *w, int *ldw, int *info, ftnlen uplo_len)
/* Subroutine */ void RELAPACK_chetrf_rook_rec2(char *uplo, blasint *n,
int *nb, blasint *kb, complex *a, blasint *lda, blasint *ipiv,
complex *w, blasint *ldw, blasint *info, ftnlen uplo_len)
{
/* 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;
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 *);
/* Local variables */
static int j, k, p;
static blasint j, k, p;
static float t, r1;
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 int imax, jmax;
static blasint imax, jmax;
static float alpha;
extern logical lsame_(char *, char *, ftnlen, ftnlen);
extern /* Subroutine */ int cgemv_(char *, int *, int *, complex *
, complex *, int *, complex *, int *, complex *, complex *
, int *, ftnlen);
extern /* Subroutine */ blasint cgemv_(char *, blasint *, blasint *, complex *
, complex *, blasint *, complex *, blasint *, complex *, complex *
, blasint *, ftnlen);
static float sfmin;
extern /* Subroutine */ int ccopy_(int *, complex *, int *,
complex *, int *);
static int itemp;
extern /* Subroutine */ int cswap_(int *, complex *, int *,
complex *, int *);
static int kstep;
extern /* Subroutine */ blasint ccopy_(int *, complex *, blasint *,
complex *, blasint *);
static blasint itemp;
extern /* Subroutine */ blasint cswap_(int *, complex *, blasint *,
complex *, blasint *);
static blasint kstep;
static float stemp, absakk;
extern /* Subroutine */ int clacgv_(int *, complex *, int *);
extern int icamax_(int *, complex *, int *);
extern /* Subroutine */ blasint clacgv_(int *, complex *, blasint *);
extern blasint icamax_(int *, complex *, blasint *);
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;

28
relapack/src/clauum.c
View File

@ -1,7 +1,7 @@
#include "relapack.h"
static void RELAPACK_clauum_rec(const char *, const int *, float *,
const int *, int *);
static void RELAPACK_clauum_rec(const char *, const blasint *, float *,
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.
@ -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
* */
void RELAPACK_clauum(
const char *uplo, const int *n,
float *A, const int *ldA,
int *info
const char *uplo, const blasint *n,
float *A, const blasint *ldA,
blasint *info
) {
// Check arguments
const int lower = LAPACK(lsame)(uplo, "L");
const int upper = LAPACK(lsame)(uplo, "U");
const blasint lower = LAPACK(lsame)(uplo, "L");
const blasint upper = LAPACK(lsame)(uplo, "U");
*info = 0;
if (!lower && !upper)
*info = -1;
@ -27,8 +27,8 @@ void RELAPACK_clauum(
else if (*ldA < MAX(1, *n))
*info = -4;
if (*info) {
const int minfo = -*info;
LAPACK(xerbla)("CLAUUM", &minfo);
const blasint minfo = -*info;
LAPACK(xerbla)("CLAUUM", &minfo, strlen("CLAUUM"));
return;
}
@ -42,9 +42,9 @@ void RELAPACK_clauum(
/** clauum's recursive compute kernel */
static void RELAPACK_clauum_rec(
const char *uplo, const int *n,
float *A, const int *ldA,
int *info
const char *uplo, const blasint *n,
float *A, const blasint *ldA,
blasint *info
) {
if (*n <= MAX(CROSSOVER_CLAUUM, 1)) {
@ -57,8 +57,8 @@ static void RELAPACK_clauum_rec(
const float ONE[] = { 1., 0. };
// Splitting
const int n1 = CREC_SPLIT(*n);
const int n2 = *n - n1;
const blasint n1 = CREC_SPLIT(*n);
const blasint n2 = *n - n1;
// A_TL A_TR
// A_BL A_BR

42
relapack/src/cpbtrf.c
View File

@ -1,8 +1,8 @@
#include "relapack.h"
#include "stdlib.h"
static void RELAPACK_cpbtrf_rec(const char *, const int *, const int *,
float *, const int *, float *, const int *, int *);
static void RELAPACK_cpbtrf_rec(const char *, const blasint *, const blasint *,
float *, const blasint *, float *, const blasint *, blasint *);
/** 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
* */
void RELAPACK_cpbtrf(
const char *uplo, const int *n, const int *kd,
float *Ab, const int *ldAb,
int *info
const char *uplo, const blasint *n, const blasint *kd,
float *Ab, const blasint *ldAb,
blasint *info
) {
// Check arguments
const int lower = LAPACK(lsame)(uplo, "L");
const int upper = LAPACK(lsame)(uplo, "U");
const blasint lower = LAPACK(lsame)(uplo, "L");
const blasint upper = LAPACK(lsame)(uplo, "U");
*info = 0;
if (!lower && !upper)
*info = -1;
@ -30,8 +30,8 @@ void RELAPACK_cpbtrf(
else if (*ldAb < *kd + 1)
*info = -5;
if (*info) {
const int minfo = -*info;
LAPACK(xerbla)("CPBTRF", &minfo);
const blasint minfo = -*info;
LAPACK(xerbla)("CPBTRF", &minfo, strlen("CPBTRF"));
return;
}
@ -42,9 +42,9 @@ void RELAPACK_cpbtrf(
const float ZERO[] = { 0., 0. };
// Allocate work space
const int n1 = CREC_SPLIT(*n);
const int mWork = (*kd > n1) ? (lower ? *n - *kd : n1) : *kd;
const int nWork = (*kd > n1) ? (lower ? n1 : *n - *kd) : *kd;
const blasint n1 = CREC_SPLIT(*n);
const blasint mWork = (*kd > n1) ? (lower ? *n - *kd : n1) : *kd;
const blasint nWork = (*kd > n1) ? (lower ? n1 : *n - *kd) : *kd;
float *Work = malloc(mWork * nWork * 2 * sizeof(float));
LAPACK(claset)(uplo, &mWork, &nWork, ZERO, ZERO, Work, &mWork);
@ -58,10 +58,10 @@ void RELAPACK_cpbtrf(
/** cpbtrf's recursive compute kernel */
static void RELAPACK_cpbtrf_rec(
const char *uplo, const int *n, const int *kd,
float *Ab, const int *ldAb,
float *Work, const int *ldWork,
int *info
const char *uplo, const blasint *n, const blasint *kd,
float *Ab, const blasint *ldAb,
float *Work, const blasint *ldWork,
blasint *info
){
if (*n <= MAX(CROSSOVER_CPBTRF, 1)) {
@ -75,12 +75,12 @@ static void RELAPACK_cpbtrf_rec(
const float MONE[] = { -1., 0. };
// Unskew A
const int ldA[] = { *ldAb - 1 };
const blasint ldA[] = { *ldAb - 1 };
float *const A = Ab + 2 * ((*uplo == 'L') ? 0 : *kd);
// Splitting
const int n1 = MIN(CREC_SPLIT(*n), *kd);
const int n2 = *n - n1;
const blasint n1 = MIN(CREC_SPLIT(*n), *kd);
const blasint n2 = *n - n1;
// * *
// * Ab_BR
@ -99,8 +99,8 @@ static void RELAPACK_cpbtrf_rec(
return;
// Banded splitting
const int n21 = MIN(n2, *kd - n1);
const int n22 = MIN(n2 - n21, *kd);
const blasint n21 = MIN(n2, *kd - n1);
const blasint n22 = MIN(n2 - n21, *kd);
// n1 n21 n22
// n1 * A_TRl A_TRr

28
relapack/src/cpotrf.c
View File

@ -1,7 +1,7 @@
#include "relapack.h"
static void RELAPACK_cpotrf_rec(const char *, const int *, float *,
const int *, int *);
static void RELAPACK_cpotrf_rec(const char *, const blasint *, float *,
const blasint *, blasint *);
/** 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
* */
void RELAPACK_cpotrf(
const char *uplo, const int *n,
float *A, const int *ldA,
int *info
const char *uplo, const blasint *n,
float *A, const blasint *ldA,
blasint *info
) {
// Check arguments
const int lower = LAPACK(lsame)(uplo, "L");
const int upper = LAPACK(lsame)(uplo, "U");
const blasint lower = LAPACK(lsame)(uplo, "L");
const blasint upper = LAPACK(lsame)(uplo, "U");
*info = 0;
if (!lower && !upper)
*info = -1;
@ -27,8 +27,8 @@ void RELAPACK_cpotrf(
else if (*ldA < MAX(1, *n))
*info = -4;
if (*info) {
const int minfo = -*info;
LAPACK(xerbla)("CPOTRF", &minfo);
const blasint minfo = -*info;
LAPACK(xerbla)("CPOTRF", &minfo, strlen("CPOTRF"));
return;
}
@ -42,9 +42,9 @@ void RELAPACK_cpotrf(
/** cpotrf's recursive compute kernel */
static void RELAPACK_cpotrf_rec(
const char *uplo, const int *n,
float *A, const int *ldA,
int *info
const char *uplo, const blasint *n,
float *A, const blasint *ldA,
blasint *info
){
if (*n <= MAX(CROSSOVER_CPOTRF, 1)) {
@ -58,8 +58,8 @@ static void RELAPACK_cpotrf_rec(
const float MONE[] = { -1., 0. };
// Splitting
const int n1 = CREC_SPLIT(*n);
const int n2 = *n - n1;
const blasint n1 = CREC_SPLIT(*n);
const blasint n2 = *n - n1;
// A_TL A_TR
// A_BL A_BR

72
relapack/src/csytrf.c
View File

@ -3,8 +3,8 @@
#include <stdlib.h>
#endif
static void RELAPACK_csytrf_rec(const char *, const int *, const int *, int *,
float *, const int *, int *, float *, const int *, int *);
static void RELAPACK_csytrf_rec(const char *, const blasint *, const blasint *, blasint *,
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.
@ -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
* */
void RELAPACK_csytrf(
const char *uplo, const int *n,
float *A, const int *ldA, int *ipiv,
float *Work, const int *lWork, int *info
const char *uplo, const blasint *n,
float *A, const blasint *ldA, blasint *ipiv,
float *Work, const blasint *lWork, blasint *info
) {
// Required work size
const int cleanlWork = *n * (*n / 2);
int minlWork = cleanlWork;
const blasint cleanlWork = *n * (*n / 2);
blasint minlWork = cleanlWork;
#if XSYTRF_ALLOW_MALLOC
minlWork = 1;
#endif
// Check arguments
const int lower = LAPACK(lsame)(uplo, "L");
const int upper = LAPACK(lsame)(uplo, "U");
const blasint lower = LAPACK(lsame)(uplo, "L");
const blasint upper = LAPACK(lsame)(uplo, "U");
*info = 0;
if (!lower && !upper)
*info = -1;
@ -55,8 +55,8 @@ void RELAPACK_csytrf(
#endif
if (*info) {
const int minfo = -*info;
LAPACK(xerbla)("CSYTRF", &minfo);
const blasint minfo = -*info;
LAPACK(xerbla)("CSYTRF", &minfo, strlen("CSYTRF"));
return;
}
@ -64,7 +64,7 @@ void RELAPACK_csytrf(
const char cleanuplo = lower ? 'L' : 'U';
// Dummy arguments
int nout;
blasint nout;
// Recursive kernel
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 */
static void RELAPACK_csytrf_rec(
const char *uplo, const int *n_full, const int *n, int *n_out,
float *A, const int *ldA, int *ipiv,
float *Work, const int *ldWork, int *info
const char *uplo, const blasint *n_full, const blasint *n, blasint *n_out,
float *A, const blasint *ldA, blasint *ipiv,
float *Work, const blasint *ldWork, blasint *info
) {
// top recursion level?
const int top = *n_full == *n;
const blasint top = *n_full == *n;
if (*n <= MAX(CROSSOVER_CSYTRF, 3)) {
// Unblocked
@ -96,34 +96,34 @@ static void RELAPACK_csytrf_rec(
return;
}
int info1, info2;
blasint info1, info2;
// Constants
const float ONE[] = { 1., 0. };
const float MONE[] = { -1., 0. };
const int iONE[] = { 1 };
const blasint iONE[] = { 1 };
// Loop iterator
int i;
blasint i;
const int n_rest = *n_full - *n;
const blasint n_rest = *n_full - *n;
if (*uplo == 'L') {
// Splitting (setup)
int n1 = CREC_SPLIT(*n);
int n2 = *n - n1;
blasint n1 = CREC_SPLIT(*n);
blasint n2 = *n - n1;
// Work_L *
float *const Work_L = Work;
// 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);
n1 = n1_out;
// Splitting (continued)
n2 = *n - n1;
const int n_full2 = *n_full - n1;
const blasint n_full2 = *n_full - n1;
// * *
// A_BL A_BR
@ -139,23 +139,23 @@ static void RELAPACK_csytrf_rec(
// (top recursion level: use Work as Work_BR)
float *const Work_BL = Work + 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_B
int *const ipiv_B = ipiv + n1;
blasint *const ipiv_B = ipiv + n1;
// 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);
BLAS(cgemm)("N", "T", &n_rest, &n2, &n1, MONE, A_BL_B, ldA, Work_BL, ldWork, ONE, A_BR_B, ldA);
// 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);
if (n2_out != n2) {
// undo 1 column of updates
const int n_restp1 = n_rest + 1;
const blasint n_restp1 = n_rest + 1;
// last column of A_BR
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;
} else {
// Splitting (setup)
int n2 = CREC_SPLIT(*n);
int n1 = *n - n2;
blasint n2 = CREC_SPLIT(*n);
blasint n1 = *n - n2;
// * Work_R
// (top recursion level: use Work as Work_R)
float *const Work_R = top ? Work : Work + 2 * *ldWork * n1;
// 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);
const int n2_diff = n2 - n2_out;
const blasint n2_diff = n2 - n2_out;
n2 = n2_out;
// Splitting (continued)
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 A_TR
@ -213,19 +213,19 @@ static void RELAPACK_csytrf_rec(
// (top recursion level: Work_R was Work)
float *const Work_L = Work;
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'
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);
// 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);
if (n1_out != n1) {
// 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'
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 */
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.
*
@ -24,12 +24,12 @@ static int c__1 = 1;
* The blocked BLAS Level 3 updates were removed and moved to the
* recursive algorithm.
* */
/* Subroutine */ void RELAPACK_csytrf_rec2(char *uplo, int *n, int *
nb, int *kb, complex *a, int *lda, int *ipiv, complex *w,
int *ldw, int *info, ftnlen uplo_len)
/* Subroutine */ void RELAPACK_csytrf_rec2(char *uplo, blasint *n, blasint *
nb, blasint *kb, complex *a, blasint *lda, blasint *ipiv, complex *w,
int *ldw, blasint *info, ftnlen uplo_len)
{
/* 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;
complex q__1, q__2, q__3;
@ -38,21 +38,21 @@ static int c__1 = 1;
void c_div(complex *, complex *, complex *);
/* Local variables */
static int j, k;
static blasint j, k;
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;
extern /* Subroutine */ int cscal_(int *, complex *, complex *,
int *);
extern /* Subroutine */ blasint cscal_(int *, complex *, complex *,
blasint *);
extern logical lsame_(char *, char *, ftnlen, ftnlen);
extern /* Subroutine */ int cgemv_(char *, int *, int *, complex *
, complex *, int *, complex *, int *, complex *, complex *
, int *, ftnlen), ccopy_(int *, complex *, int *,
complex *, int *), cswap_(int *, complex *, int *,
complex *, int *);
static int kstep;
extern /* Subroutine */ blasint cgemv_(char *, blasint *, blasint *, complex *
, complex *, blasint *, complex *, blasint *, complex *, complex *
, blasint *, ftnlen), ccopy_(int *, complex *, blasint *,
complex *, blasint *), cswap_(int *, complex *, blasint *,
complex *, blasint *);
static blasint kstep;
static float absakk;
extern int icamax_(int *, complex *, int *);
extern blasint icamax_(int *, complex *, blasint *);
static float colmax, rowmax;
/* Parameter adjustments */

72
relapack/src/csytrf_rook.c
View File

@ -3,8 +3,8 @@
#include <stdlib.h>
#endif
static void RELAPACK_csytrf_rook_rec(const char *, const int *, const int *, int *,
float *, const int *, int *, float *, const int *, int *);
static void RELAPACK_csytrf_rook_rec(const char *, const blasint *, const blasint *, blasint *,
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.
@ -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
* */
void RELAPACK_csytrf_rook(
const char *uplo, const int *n,
float *A, const int *ldA, int *ipiv,
float *Work, const int *lWork, int *info
const char *uplo, const blasint *n,
float *A, const blasint *ldA, blasint *ipiv,
float *Work, const blasint *lWork, blasint *info
) {
// Required work size
const int cleanlWork = *n * (*n / 2);
int minlWork = cleanlWork;
const blasint cleanlWork = *n * (*n / 2);
blasint minlWork = cleanlWork;
#if XSYTRF_ALLOW_MALLOC
minlWork = 1;
#endif
// Check arguments
const int lower = LAPACK(lsame)(uplo, "L");
const int upper = LAPACK(lsame)(uplo, "U");
const blasint lower = LAPACK(lsame)(uplo, "L");
const blasint upper = LAPACK(lsame)(uplo, "U");
*info = 0;
if (!lower && !upper)
*info = -1;
@ -55,8 +55,8 @@ void RELAPACK_csytrf_rook(
#endif
if (*info) {
const int minfo = -*info;
LAPACK(xerbla)("CSYTRF", &minfo);
const blasint minfo = -*info;
LAPACK(xerbla)("CSYTRF", &minfo, strlen("CSYTRF"));
return;
}
@ -64,7 +64,7 @@ void RELAPACK_csytrf_rook(
const char cleanuplo = lower ? 'L' : 'U';
// Dummy argument
int nout;
blasint nout;
// Recursive kernel
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 */
static void RELAPACK_csytrf_rook_rec(
const char *uplo, const int *n_full, const int *n, int *n_out,
float *A, const int *ldA, int *ipiv,
float *Work, const int *ldWork, int *info
const char *uplo, const blasint *n_full, const blasint *n, blasint *n_out,
float *A, const blasint *ldA, blasint *ipiv,
float *Work, const blasint *ldWork, blasint *info
) {
// top recursion level?
const int top = *n_full == *n;
const blasint top = *n_full == *n;
if (*n <= MAX(CROSSOVER_CSYTRF_ROOK, 3)) {
// Unblocked
@ -96,31 +96,31 @@ static void RELAPACK_csytrf_rook_rec(
return;
}
int info1, info2;
blasint info1, info2;
// Constants
const float ONE[] = { 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') {
// Splitting (setup)
int n1 = CREC_SPLIT(*n);
int n2 = *n - n1;
blasint n1 = CREC_SPLIT(*n);
blasint n2 = *n - n1;
// Work_L *
float *const Work_L = Work;
// 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);
n1 = n1_out;
// Splitting (continued)
n2 = *n - n1;
const int n_full2 = *n_full - n1;
const blasint n_full2 = *n_full - n1;
// * *
// A_BL A_BR
@ -136,23 +136,23 @@ static void RELAPACK_csytrf_rook_rec(
// (top recursion level: use Work as Work_BR)
float *const Work_BL = Work + 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_B
int *const ipiv_B = ipiv + n1;
blasint *const ipiv_B = ipiv + n1;
// 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);
BLAS(cgemm)("N", "T", &n_rest, &n2, &n1, MONE, A_BL_B, ldA, Work_BL, ldWork, ONE, A_BR_B, ldA);
// 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);
if (n2_out != n2) {
// undo 1 column of updates
const int n_restp1 = n_rest + 1;
const blasint n_restp1 = n_rest + 1;
// last column of A_BR
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;
// shift pivots
int i;
blasint i;
for (i = 0; i < n2; i++)
if (ipiv_B[i] > 0)
ipiv_B[i] += n1;
@ -180,22 +180,22 @@ static void RELAPACK_csytrf_rook_rec(
*n_out = n1 + n2;
} else {
// Splitting (setup)
int n2 = CREC_SPLIT(*n);
int n1 = *n - n2;
blasint n2 = CREC_SPLIT(*n);
blasint n1 = *n - n2;
// * Work_R
// (top recursion level: use Work as Work_R)
float *const Work_R = top ? Work : Work + 2 * *ldWork * n1;
// 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);
const int n2_diff = n2 - n2_out;
const blasint n2_diff = n2 - n2_out;
n2 = n2_out;
// Splitting (continued)
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 A_TR
@ -211,19 +211,19 @@ static void RELAPACK_csytrf_rook_rec(
// (top recursion level: Work_R was Work)
float *const Work_L = Work;
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'
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);
// 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);
if (n1_out != n1) {
// 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'
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 */
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.
*
@ -24,12 +24,12 @@ static int c__1 = 1;
* The blocked BLAS Level 3 updates were removed and moved to the
* recursive algorithm.
* */
/* Subroutine */ void RELAPACK_csytrf_rook_rec2(char *uplo, int *n,
int *nb, int *kb, complex *a, int *lda, int *ipiv,
complex *w, int *ldw, int *info, ftnlen uplo_len)
/* Subroutine */ void RELAPACK_csytrf_rook_rec2(char *uplo, blasint *n,
int *nb, blasint *kb, complex *a, blasint *lda, blasint *ipiv,
complex *w, blasint *ldw, blasint *info, ftnlen uplo_len)
{
/* 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;
complex q__1, q__2, q__3, q__4;
@ -38,27 +38,27 @@ static int c__1 = 1;
void c_div(complex *, complex *, complex *);
/* Local variables */
static int j, k, p;
static blasint j, k, p;
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 int imax, jmax;
static blasint imax, jmax;
static float alpha;
extern /* Subroutine */ int cscal_(int *, complex *, complex *,
int *);
extern /* Subroutine */ blasint cscal_(int *, complex *, complex *,
blasint *);
extern logical lsame_(char *, char *, ftnlen, ftnlen);
extern /* Subroutine */ int cgemv_(char *, int *, int *, complex *
, complex *, int *, complex *, int *, complex *, complex *
, int *, ftnlen);
extern /* Subroutine */ blasint cgemv_(char *, blasint *, blasint *, complex *
, complex *, blasint *, complex *, blasint *, complex *, complex *
, blasint *, ftnlen);
static float sfmin;
extern /* Subroutine */ int ccopy_(int *, complex *, int *,
complex *, int *);
static int itemp;
extern /* Subroutine */ int cswap_(int *, complex *, int *,
complex *, int *);
static int kstep;
extern /* Subroutine */ blasint ccopy_(int *, complex *, blasint *,
complex *, blasint *);
static blasint itemp;
extern /* Subroutine */ blasint cswap_(int *, complex *, blasint *,
complex *, blasint *);
static blasint kstep;
static float stemp, absakk;
extern int icamax_(int *, complex *, int *);
extern blasint icamax_(int *, complex *, blasint *);
extern double slamch_(char *, ftnlen);
static float colmax, rowmax;

62
relapack/src/ctgsyl.c
View File

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

52
relapack/src/ctrsyl.c
View File

@ -1,8 +1,8 @@
#include "relapack.h"
static void RELAPACK_ctrsyl_rec(const char *, const char *, const int *,
const int *, const int *, const float *, const int *, const float *,
const int *, float *, const int *, float *, int *);
static void RELAPACK_ctrsyl_rec(const char *, const char *, const blasint *,
const blasint *, const blasint *, const float *, const blasint *, const float *,
const blasint *, float *, const blasint *, float *, blasint *);
/** 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
* */
void RELAPACK_ctrsyl(
const char *tranA, const char *tranB, const int *isgn,
const int *m, const int *n,
const float *A, const int *ldA, const float *B, const int *ldB,
float *C, const int *ldC, float *scale,
int *info
const char *tranA, const char *tranB, const blasint *isgn,
const blasint *m, const blasint *n,
const float *A, const blasint *ldA, const float *B, const blasint *ldB,
float *C, const blasint *ldC, float *scale,
blasint *info
) {
// Check arguments
const int notransA = LAPACK(lsame)(tranA, "N");
const int ctransA = LAPACK(lsame)(tranA, "C");
const int notransB = LAPACK(lsame)(tranB, "N");
const int ctransB = LAPACK(lsame)(tranB, "C");
const blasint notransA = LAPACK(lsame)(tranA, "N");
const blasint ctransA = LAPACK(lsame)(tranA, "C");
const blasint notransB = LAPACK(lsame)(tranB, "N");
const blasint ctransB = LAPACK(lsame)(tranB, "C");
*info = 0;
if (!ctransA && !notransA)
*info = -1;
@ -42,8 +42,8 @@ void RELAPACK_ctrsyl(
else if (*ldC < MAX(1, *m))
*info = -11;
if (*info) {
const int minfo = -*info;
LAPACK(xerbla)("CTRSYL", &minfo);
const blasint minfo = -*info;
LAPACK(xerbla)("CTRSYL", &minfo, strlen("CTRSYL"));
return;
}
@ -58,11 +58,11 @@ void RELAPACK_ctrsyl(
/** ctrsyl's recursive compute kernel */
static void RELAPACK_ctrsyl_rec(
const char *tranA, const char *tranB, const int *isgn,
const int *m, const int *n,
const float *A, const int *ldA, const float *B, const int *ldB,
float *C, const int *ldC, float *scale,
int *info
const char *tranA, const char *tranB, const blasint *isgn,
const blasint *m, const blasint *n,
const float *A, const blasint *ldA, const float *B, const blasint *ldB,
float *C, const blasint *ldC, float *scale,
blasint *info
) {
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 MONE[] = { -1., 0. };
const float MSGN[] = { -*isgn, 0. };
const int iONE[] = { 1 };
const blasint iONE[] = { 1 };
// Outputs
float scale1[] = { 1., 0. };
float scale2[] = { 1., 0. };
int info1[] = { 0 };
int info2[] = { 0 };
blasint info1[] = { 0 };
blasint info2[] = { 0 };
if (*m > *n) {
// Splitting
const int m1 = CREC_SPLIT(*m);
const int m2 = *m - m1;
const blasint m1 = CREC_SPLIT(*m);
const blasint m2 = *m - m1;
// A_TL A_TR
// 0 A_BR
@ -122,8 +122,8 @@ static void RELAPACK_ctrsyl_rec(
}
} else {
// Splitting
const int n1 = CREC_SPLIT(*n);
const int n2 = *n - n1;
const blasint n1 = CREC_SPLIT(*n);
const blasint n2 = *n - n1;
// B_TL B_TR
// 0 B_BR

36
relapack/src/ctrsyl_rec2.c
View File

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

34
relapack/src/ctrtri.c
View File

@ -1,7 +1,7 @@
#include "relapack.h"
static void RELAPACK_ctrtri_rec(const char *, const char *, const int *,
float *, const int *, int *);
static void RELAPACK_ctrtri_rec(const char *, const char *, const blasint *,
float *, const blasint *, blasint *);
/** 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
* */
void RELAPACK_ctrtri(
const char *uplo, const char *diag, const int *n,
float *A, const int *ldA,
int *info
const char *uplo, const char *diag, const blasint *n,
float *A, const blasint *ldA,
blasint *info
) {
// Check arguments
const int lower = LAPACK(lsame)(uplo, "L");
const int upper = LAPACK(lsame)(uplo, "U");
const int nounit = LAPACK(lsame)(diag, "N");
const int unit = LAPACK(lsame)(diag, "U");
const blasint lower = LAPACK(lsame)(uplo, "L");
const blasint upper = LAPACK(lsame)(uplo, "U");
const blasint nounit = LAPACK(lsame)(diag, "N");
const blasint unit = LAPACK(lsame)(diag, "U");
*info = 0;
if (!lower && !upper)
*info = -1;
@ -31,8 +31,8 @@ void RELAPACK_ctrtri(
else if (*ldA < MAX(1, *n))
*info = -5;
if (*info) {
const int minfo = -*info;
LAPACK(xerbla)("CTRTRI", &minfo);
const blasint minfo = -*info;
LAPACK(xerbla)("CTRTRI", &minfo, strlen("CTRTRI"));
return;
}
@ -42,7 +42,7 @@ void RELAPACK_ctrtri(
// check for singularity
if (nounit) {
int i;
blasint i;
for (i = 0; i < *n; i++)
if (A[2 * (i + *ldA * i)] == 0 && A[2 * (i + *ldA * i) + 1] == 0) {
*info = i;
@ -57,9 +57,9 @@ void RELAPACK_ctrtri(
/** ctrtri's recursive compute kernel */
static void RELAPACK_ctrtri_rec(
const char *uplo, const char *diag, const int *n,
float *A, const int *ldA,
int *info
const char *uplo, const char *diag, const blasint *n,
float *A, const blasint *ldA,
blasint *info
){
if (*n <= MAX(CROSSOVER_CTRTRI, 1)) {
@ -73,8 +73,8 @@ static void RELAPACK_ctrtri_rec(
const float MONE[] = { -1., 0. };
// Splitting
const int n1 = CREC_SPLIT(*n);
const int n2 = *n - n1;
const blasint n1 = CREC_SPLIT(*n);
const blasint n2 = *n - n1;
// A_TL A_TR
// A_BL A_BR

80
relapack/src/dgbtrf.c
View File

@ -1,9 +1,8 @@
#include "relapack.h"
#include "stdlib.h"
static void RELAPACK_dgbtrf_rec(const int *, const int *, const int *,
const int *, double *, const int *, int *, double *, const int *, double *,
const int *, int *);
static void RELAPACK_dgbtrf_rec(const blasint *, const blasint *, const blasint *,
const blasint *, double *, const blasint *, blasint *, double *, const blasint *, double *,
const blasint *, blasint *);
/** 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
* */
void RELAPACK_dgbtrf(
const int *m, const int *n, const int *kl, const int *ku,
double *Ab, const int *ldAb, int *ipiv,
int *info
const blasint *m, const blasint *n, const blasint *kl, const blasint *ku,
double *Ab, const blasint *ldAb, blasint *ipiv,
blasint *info
) {
// Check arguments
@ -31,8 +30,8 @@ void RELAPACK_dgbtrf(
else if (*ldAb < 2 * *kl + *ku + 1)
*info = -6;
if (*info) {
const int minfo = -*info;
LAPACK(xerbla)("DGBTRF", &minfo);
const blasint minfo = -*info;
LAPACK(xerbla)("DGBTRF", &minfo, strlen("DGBTRF"));
return;
}
@ -40,14 +39,14 @@ void RELAPACK_dgbtrf(
const double ZERO[] = { 0. };
// Result upper band width
const int kv = *ku + *kl;
const blasint kv = *ku + *kl;
// Unskew A
const int ldA[] = { *ldAb - 1 };
const blasint ldA[] = { *ldAb - 1 };
double *const A = Ab + kv;
// Zero upper diagonal fill-in elements
int i, j;
blasint i, j;
for (j = 0; j < *n; j++) {
double *const A_j = A + *ldA * j;
for (i = MAX(0, j - kv); i < j - *ku; i++)
@ -55,11 +54,12 @@ void RELAPACK_dgbtrf(
}
// Allocate work space
const int n1 = DREC_SPLIT(*n);
const int mWorkl = (kv > n1) ? MAX(1, *m - *kl) : kv;
const int nWorkl = (kv > n1) ? n1 : kv;
const int mWorku = (*kl > n1) ? n1 : *kl;
const int nWorku = (*kl > n1) ? MAX(0, *n - *kl) : *kl;
const blasint n1 = DREC_SPLIT(*n);
const blasint mWorkl = abs( (kv > n1) ? MAX(1, *m - *kl) : kv);
const blasint nWorkl = abs( (kv > n1) ? n1 : kv);
const blasint mWorku = abs( (*kl > n1) ? n1 : *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 *Worku = malloc(mWorku * nWorku * sizeof(double));
LAPACK(dlaset)("L", &mWorkl, &nWorkl, ZERO, ZERO, Workl, &mWorkl);
@ -76,10 +76,10 @@ void RELAPACK_dgbtrf(
/** dgbtrf's recursive compute kernel */
static void RELAPACK_dgbtrf_rec(
const int *m, const int *n, const int *kl, const int *ku,
double *Ab, const int *ldAb, int *ipiv,
double *Workl, const int *ldWorkl, double *Worku, const int *ldWorku,
int *info
const blasint *m, const blasint *n, const blasint *kl, const blasint *ku,
double *Ab, const blasint *ldAb, blasint *ipiv,
double *Workl, const blasint *ldWorkl, double *Worku, const blasint *ldWorku,
blasint *info
) {
if (*n <= MAX(CROSSOVER_DGBTRF, 1)) {
@ -91,25 +91,25 @@ static void RELAPACK_dgbtrf_rec(
// Constants
const double ONE[] = { 1. };
const double MONE[] = { -1. };
const int iONE[] = { 1 };
const blasint iONE[] = { 1 };
// Loop iterators
int i, j;
blasint i, j;
// Output upper band width
const int kv = *ku + *kl;
const blasint kv = *ku + *kl;
// Unskew A
const int ldA[] = { *ldAb - 1 };
const blasint ldA[] = { *ldAb - 1 };
double *const A = Ab + kv;
// Splitting
const int n1 = MIN(DREC_SPLIT(*n), *kl);
const int n2 = *n - n1;
const int m1 = MIN(n1, *m);
const int m2 = *m - m1;
const int mn1 = MIN(m1, n1);
const int mn2 = MIN(m2, n2);
const blasint n1 = MIN(DREC_SPLIT(*n), *kl);
const blasint n2 = *n - n1;
const blasint m1 = MIN(n1, *m);
const blasint m2 = *m - m1;
const blasint mn1 = MIN(m1, n1);
const blasint mn2 = MIN(m2, n2);
// Ab_L *
// Ab_BR
@ -129,14 +129,14 @@ static void RELAPACK_dgbtrf_rec(
// ipiv_T
// ipiv_B
int *const ipiv_T = ipiv;
int *const ipiv_B = ipiv + n1;
blasint *const ipiv_T = ipiv;
blasint *const ipiv_B = ipiv + n1;
// Banded splitting
const int n21 = MIN(n2, kv - n1);
const int n22 = MIN(n2 - n21, n1);
const int m21 = MIN(m2, *kl - m1);
const int m22 = MIN(m2 - m21, m1);
const blasint n21 = MIN(n2, kv - n1);
const blasint n22 = MIN(n2 - n21, n1);
const blasint m21 = MIN(m2, *kl - m1);
const blasint m22 = MIN(m2 - m21, m1);
// n1 n21 n22
// m * A_Rl ARr
@ -164,7 +164,7 @@ static void RELAPACK_dgbtrf_rec(
// partially redo swaps in A_L
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 < *kl)
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++) {
double *const A_Rrj = A_Rr + *ldA * j;
for (i = j; i < mn1; i++) {
const int ip = ipiv_T[i] - 1;
const blasint ip = ipiv_T[i] - 1;
if (ip != i) {
const double tmp = A_Rrj[i];
A_Rrj[i] = A_Rr[ip];
@ -208,7 +208,7 @@ static void RELAPACK_dgbtrf_rec(
// partially undo swaps in A_L
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 < *kl)
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"
static void RELAPACK_dgemmt_rec(const char *, const char *, const char *,
const int *, const int *, const double *, const double *, const int *,
const double *, const int *, const double *, double *, const int *);
const blasint *, const blasint *, const double *, const double *, const blasint *,
const double *, const blasint *, const double *, double *, const blasint *);
static void RELAPACK_dgemmt_rec2(const char *, const char *, const char *,
const int *, const int *, const double *, const double *, const int *,
const double *, const int *, const double *, double *, const int *);
const blasint *, const blasint *, const double *, const double *, const blasint *,
const double *, const blasint *, const double *, double *, const blasint *);
/** 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(
const char *uplo, const char *transA, const char *transB,
const int *n, const int *k,
const double *alpha, const double *A, const int *ldA,
const double *B, const int *ldB,
const double *beta, double *C, const int *ldC
const blasint *n, const blasint *k,
const double *alpha, const double *A, const blasint *ldA,
const double *B, const blasint *ldB,
const double *beta, double *C, const blasint *ldC
) {
#if HAVE_XGEMMT
@ -32,13 +32,13 @@ void RELAPACK_dgemmt(
#else
// Check arguments
const int lower = LAPACK(lsame)(uplo, "L");
const int upper = LAPACK(lsame)(uplo, "U");
const int notransA = LAPACK(lsame)(transA, "N");
const int tranA = LAPACK(lsame)(transA, "T");
const int notransB = LAPACK(lsame)(transB, "N");
const int tranB = LAPACK(lsame)(transB, "T");
int info = 0;
const blasint lower = LAPACK(lsame)(uplo, "L");
const blasint upper = LAPACK(lsame)(uplo, "U");
const blasint notransA = LAPACK(lsame)(transA, "N");
const blasint tranA = LAPACK(lsame)(transA, "T");
const blasint notransB = LAPACK(lsame)(transB, "N");
const blasint tranB = LAPACK(lsame)(transB, "T");
blasint info = 0;
if (!lower && !upper)
info = 1;
else if (!tranA && !notransA)
@ -56,7 +56,7 @@ void RELAPACK_dgemmt(
else if (*ldC < MAX(1, *n))
info = 13;
if (info) {
LAPACK(xerbla)("DGEMMT", &info);
LAPACK(xerbla)("DGEMMT", &info, strlen("DGEMMT"));
return;
}
@ -74,10 +74,10 @@ void RELAPACK_dgemmt(
/** dgemmt's recursive compute kernel */
static void RELAPACK_dgemmt_rec(
const char *uplo, const char *transA, const char *transB,
const int *n, const int *k,
const double *alpha, const double *A, const int *ldA,
const double *B, const int *ldB,
const double *beta, double *C, const int *ldC
const blasint *n, const blasint *k,
const double *alpha, const double *A, const blasint *ldA,
const double *B, const blasint *ldB,
const double *beta, double *C, const blasint *ldC
) {
if (*n <= MAX(CROSSOVER_DGEMMT, 1)) {
@ -87,8 +87,8 @@ static void RELAPACK_dgemmt_rec(
}
// Splitting
const int n1 = DREC_SPLIT(*n);
const int n2 = *n - n1;
const blasint n1 = DREC_SPLIT(*n);
const blasint n2 = *n - n1;
// A_T
// A_B
@ -124,16 +124,16 @@ static void RELAPACK_dgemmt_rec(
/** dgemmt's unblocked compute kernel */
static void RELAPACK_dgemmt_rec2(
const char *uplo, const char *transA, const char *transB,
const int *n, const int *k,
const double *alpha, const double *A, const int *ldA,
const double *B, const int *ldB,
const double *beta, double *C, const int *ldC
const blasint *n, const blasint *k,
const double *alpha, const double *A, const blasint *ldA,
const double *B, const blasint *ldB,
const double *beta, double *C, const blasint *ldC
) {
const int incB = (*transB == 'N') ? 1 : *ldB;
const int incC = 1;
const blasint incB = (*transB == 'N') ? 1 : *ldB;
const blasint incC = 1;
int i;
blasint i;
for (i = 0; i < *n; i++) {
// A_0
// A_i
@ -149,13 +149,13 @@ static void RELAPACK_dgemmt_rec2(
double *const C_ii = C + *ldC * i + i;
if (*uplo == 'L') {
const int nmi = *n - i;
const blasint nmi = *n - i;
if (*transA == 'N')
BLAS(dgemv)(transA, &nmi, k, alpha, A_i, ldA, B_i, &incB, beta, C_ii, &incC);
else
BLAS(dgemv)(transA, k, &nmi, alpha, A_i, ldA, B_i, &incB, beta, C_ii, &incC);
} else {
const int ip1 = i + 1;
const blasint ip1 = i + 1;
if (*transA == 'N')
BLAS(dgemv)(transA, &ip1, k, alpha, A_0, ldA, B_i, &incB, beta, C_0i, &incC);
else

40
relapack/src/dgetrf.c
View File

@ -1,7 +1,7 @@
#include "relapack.h"
static void RELAPACK_dgetrf_rec(const int *, const int *, double *,
const int *, int *, int *);
static void RELAPACK_dgetrf_rec(const blasint *, const blasint *, double *,
const blasint *, blasint *, blasint *);
/** 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
* */
void RELAPACK_dgetrf(
const int *m, const int *n,
double *A, const int *ldA, int *ipiv,
int *info
const blasint *m, const blasint *n,
double *A, const blasint *ldA, blasint *ipiv,
blasint *info
) {
// Check arguments
@ -25,12 +25,12 @@ void RELAPACK_dgetrf(
else if (*ldA < MAX(1, *n))
*info = -4;
if (*info) {
const int minfo = -*info;
LAPACK(xerbla)("DGETRF", &minfo);
const blasint minfo = -*info;
LAPACK(xerbla)("DGETRF", &minfo, strlen("DGETRF"));
return;
}
const int sn = MIN(*m, *n);
const blasint sn = MIN(*m, *n);
RELAPACK_dgetrf_rec(m, &sn, A, ldA, ipiv, info);
@ -38,10 +38,10 @@ void RELAPACK_dgetrf(
if (*m < *n) {
// Constants
const double ONE[] = { 1. };
const int iONE[] = { 1. };
const blasint iONE[] = { 1. };
// Splitting
const int rn = *n - *m;
const blasint rn = *n - *m;
// A_L A_R
const double *const A_L = A;
@ -57,9 +57,9 @@ void RELAPACK_dgetrf(
/** dgetrf's recursive compute kernel */
static void RELAPACK_dgetrf_rec(
const int *m, const int *n,
double *A, const int *ldA, int *ipiv,
int *info
const blasint *m, const blasint *n,
double *A, const blasint *ldA, blasint *ipiv,
blasint *info
) {
if (*n <= MAX(CROSSOVER_DGETRF, 1)) {
@ -71,12 +71,12 @@ static void RELAPACK_dgetrf_rec(
// Constants
const double ONE[] = { 1. };
const double MONE[] = { -1. };
const int iONE[] = { 1 };
const blasint iONE[] = { 1 };
// Splitting
const int n1 = DREC_SPLIT(*n);
const int n2 = *n - n1;
const int m2 = *m - n1;
const blasint n1 = DREC_SPLIT(*n);
const blasint n2 = *n - n1;
const blasint m2 = *m - n1;
// A_L A_R
double *const A_L = A;
@ -91,8 +91,8 @@ static void RELAPACK_dgetrf_rec(
// ipiv_T
// ipiv_B
int *const ipiv_T = ipiv;
int *const ipiv_B = ipiv + n1;
blasint *const ipiv_T = ipiv;
blasint *const ipiv_B = ipiv + n1;
// recursion(A_L, ipiv_T)
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
LAPACK(dlaswp)(&n1, A_BL, ldA, iONE, &n2, ipiv_B, iONE);
// shift pivots
int i;
blasint i;
for (i = 0; i < n2; i++)
ipiv_B[i] += n1;
}

28
relapack/src/dlauum.c
View File

@ -1,7 +1,7 @@
#include "relapack.h"
static void RELAPACK_dlauum_rec(const char *, const int *, double *,
const int *, int *);
static void RELAPACK_dlauum_rec(const char *, const blasint *, double *,
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.
@ -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
* */
void RELAPACK_dlauum(
const char *uplo, const int *n,
double *A, const int *ldA,
int *info
const char *uplo, const blasint *n,
double *A, const blasint *ldA,
blasint *info
) {
// Check arguments
const int lower = LAPACK(lsame)(uplo, "L");
const int upper = LAPACK(lsame)(uplo, "U");
const blasint lower = LAPACK(lsame)(uplo, "L");
const blasint upper = LAPACK(lsame)(uplo, "U");
*info = 0;
if (!lower && !upper)
*info = -1;
@ -27,8 +27,8 @@ void RELAPACK_dlauum(
else if (*ldA < MAX(1, *n))
*info = -4;
if (*info) {
const int minfo = -*info;
LAPACK(xerbla)("DLAUUM", &minfo);
const blasint minfo = -*info;
LAPACK(xerbla)("DLAUUM", &minfo, strlen("DLAUUM"));
return;
}
@ -42,9 +42,9 @@ void RELAPACK_dlauum(
/** dlauum's recursive compute kernel */
static void RELAPACK_dlauum_rec(
const char *uplo, const int *n,
double *A, const int *ldA,
int *info
const char *uplo, const blasint *n,
double *A, const blasint *ldA,
blasint *info
) {
if (*n <= MAX(CROSSOVER_DLAUUM, 1)) {
@ -57,8 +57,8 @@ static void RELAPACK_dlauum_rec(
const double ONE[] = { 1. };
// Splitting
const int n1 = DREC_SPLIT(*n);
const int n2 = *n - n1;
const blasint n1 = DREC_SPLIT(*n);
const blasint n2 = *n - n1;
// A_TL A_TR
// A_BL A_BR

42
relapack/src/dpbtrf.c
View File

@ -1,8 +1,8 @@
#include "relapack.h"
#include "stdlib.h"
static void RELAPACK_dpbtrf_rec(const char *, const int *, const int *,
double *, const int *, double *, const int *, int *);
static void RELAPACK_dpbtrf_rec(const char *, const blasint *, const blasint *,
double *, const blasint *, double *, const blasint *, blasint *);
/** 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
* */
void RELAPACK_dpbtrf(
const char *uplo, const int *n, const int *kd,
double *Ab, const int *ldAb,
int *info
const char *uplo, const blasint *n, const blasint *kd,
double *Ab, const blasint *ldAb,
blasint *info
) {
// Check arguments
const int lower = LAPACK(lsame)(uplo, "L");
const int upper = LAPACK(lsame)(uplo, "U");
const blasint lower = LAPACK(lsame)(uplo, "L");
const blasint upper = LAPACK(lsame)(uplo, "U");
*info = 0;
if (!lower && !upper)
*info = -1;
@ -30,8 +30,8 @@ void RELAPACK_dpbtrf(
else if (*ldAb < *kd + 1)
*info = -5;
if (*info) {
const int minfo = -*info;
LAPACK(xerbla)("DPBTRF", &minfo);
const blasint minfo = -*info;
LAPACK(xerbla)("DPBTRF", &minfo, strlen("DPBTRF"));
return;
}
@ -42,9 +42,9 @@ void RELAPACK_dpbtrf(
const double ZERO[] = { 0. };
// Allocate work space
const int n1 = DREC_SPLIT(*n);
const int mWork = (*kd > n1) ? (lower ? *n - *kd : n1) : *kd;
const int nWork = (*kd > n1) ? (lower ? n1 : *n - *kd) : *kd;
const blasint n1 = DREC_SPLIT(*n);
const blasint mWork = (*kd > n1) ? (lower ? *n - *kd : n1) : *kd;
const blasint nWork = (*kd > n1) ? (lower ? n1 : *n - *kd) : *kd;
double *Work = malloc(mWork * nWork * sizeof(double));
LAPACK(dlaset)(uplo, &mWork, &nWork, ZERO, ZERO, Work, &mWork);
@ -58,10 +58,10 @@ void RELAPACK_dpbtrf(
/** dpbtrf's recursive compute kernel */
static void RELAPACK_dpbtrf_rec(
const char *uplo, const int *n, const int *kd,
double *Ab, const int *ldAb,
double *Work, const int *ldWork,
int *info
const char *uplo, const blasint *n, const blasint *kd,
double *Ab, const blasint *ldAb,
double *Work, const blasint *ldWork,
blasint *info
){
if (*n <= MAX(CROSSOVER_DPBTRF, 1)) {
@ -75,12 +75,12 @@ static void RELAPACK_dpbtrf_rec(
const double MONE[] = { -1. };
// Unskew A
const int ldA[] = { *ldAb - 1 };
const blasint ldA[] = { *ldAb - 1 };
double *const A = Ab + ((*uplo == 'L') ? 0 : *kd);
// Splitting
const int n1 = MIN(DREC_SPLIT(*n), *kd);
const int n2 = *n - n1;
const blasint n1 = MIN(DREC_SPLIT(*n), *kd);
const blasint n2 = *n - n1;
// * *
// * Ab_BR
@ -99,8 +99,8 @@ static void RELAPACK_dpbtrf_rec(
return;
// Banded splitting
const int n21 = MIN(n2, *kd - n1);
const int n22 = MIN(n2 - n21, n1);
const blasint n21 = MIN(n2, *kd - n1);
const blasint n22 = MIN(n2 - n21, n1);
// n1 n21 n22
// n1 * A_TRl A_TRr

28
relapack/src/dpotrf.c
View File

@ -1,7 +1,7 @@
#include "relapack.h"
static void RELAPACK_dpotrf_rec(const char *, const int *, double *,
const int *, int *);
static void RELAPACK_dpotrf_rec(const char *, const blasint *, double *,
const blasint *, blasint *);
/** 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
* */
void RELAPACK_dpotrf(
const char *uplo, const int *n,
double *A, const int *ldA,
int *info
const char *uplo, const blasint *n,
double *A, const blasint *ldA,
blasint *info
) {
// Check arguments
const int lower = LAPACK(lsame)(uplo, "L");
const int upper = LAPACK(lsame)(uplo, "U");
const blasint lower = LAPACK(lsame)(uplo, "L");
const blasint upper = LAPACK(lsame)(uplo, "U");
*info = 0;
if (!lower && !upper)
*info = -1;
@ -27,8 +27,8 @@ void RELAPACK_dpotrf(
else if (*ldA < MAX(1, *n))
*info = -4;
if (*info) {
const int minfo = -*info;
LAPACK(xerbla)("DPOTRF", &minfo);
const blasint minfo = -*info;
LAPACK(xerbla)("DPOTRF", &minfo, strlen("DPOTRF"));
return;
}
@ -42,9 +42,9 @@ void RELAPACK_dpotrf(
/** dpotrf's recursive compute kernel */
static void RELAPACK_dpotrf_rec(
const char *uplo, const int *n,
double *A, const int *ldA,
int *info
const char *uplo, const blasint *n,
double *A, const blasint *ldA,
blasint *info
){
if (*n <= MAX(CROSSOVER_DPOTRF, 1)) {
@ -58,8 +58,8 @@ static void RELAPACK_dpotrf_rec(
const double MONE[] = { -1. };
// Splitting
const int n1 = DREC_SPLIT(*n);
const int n2 = *n - n1;
const blasint n1 = DREC_SPLIT(*n);
const blasint n2 = *n - n1;
// A_TL A_TR
// A_BL A_BR

40
relapack/src/dsygst.c
View File

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

72
relapack/src/dsytrf.c
View File

@ -3,8 +3,8 @@
#include <stdlib.h>
#endif
static void RELAPACK_dsytrf_rec(const char *, const int *, const int *, int *,
double *, const int *, int *, double *, const int *, int *);
static void RELAPACK_dsytrf_rec(const char *, const blasint *, const blasint *, blasint *,
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.
@ -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
* */
void RELAPACK_dsytrf(
const char *uplo, const int *n,
double *A, const int *ldA, int *ipiv,
double *Work, const int *lWork, int *info
const char *uplo, const blasint *n,
double *A, const blasint *ldA, blasint *ipiv,
double *Work, const blasint *lWork, blasint *info
) {
// Required work size
const int cleanlWork = *n * (*n / 2);
int minlWork = cleanlWork;
const blasint cleanlWork = *n * (*n / 2);
blasint minlWork = cleanlWork;
#if XSYTRF_ALLOW_MALLOC
minlWork = 1;
#endif
// Check arguments
const int lower = LAPACK(lsame)(uplo, "L");
const int upper = LAPACK(lsame)(uplo, "U");
const blasint lower = LAPACK(lsame)(uplo, "L");
const blasint upper = LAPACK(lsame)(uplo, "U");
*info = 0;
if (!lower && !upper)
*info = -1;
@ -55,8 +55,8 @@ void RELAPACK_dsytrf(
#endif
if (*info) {
const int minfo = -*info;
LAPACK(xerbla)("DSYTRF", &minfo);
const blasint minfo = -*info;
LAPACK(xerbla)("DSYTRF", &minfo, strlen("DSYTRF"));
return;
}
@ -64,7 +64,7 @@ void RELAPACK_dsytrf(
const char cleanuplo = lower ? 'L' : 'U';
// Dummy arguments
int nout;
blasint nout;
// Recursive kernel
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 */
static void RELAPACK_dsytrf_rec(
const char *uplo, const int *n_full, const int *n, int *n_out,
double *A, const int *ldA, int *ipiv,
double *Work, const int *ldWork, int *info
const char *uplo, const blasint *n_full, const blasint *n, blasint *n_out,
double *A, const blasint *ldA, blasint *ipiv,
double *Work, const blasint *ldWork, blasint *info
) {
// top recursion level?
const int top = *n_full == *n;
const blasint top = *n_full == *n;
if (*n <= MAX(CROSSOVER_DSYTRF, 3)) {
// Unblocked
@ -96,34 +96,34 @@ static void RELAPACK_dsytrf_rec(
return;
}
int info1, info2;
blasint info1, info2;
// Constants
const double ONE[] = { 1. };
const double MONE[] = { -1. };
const int iONE[] = { 1 };
const blasint iONE[] = { 1 };
// Loop iterator
int i;
blasint i;
const int n_rest = *n_full - *n;
const blasint n_rest = *n_full - *n;
if (*uplo == 'L') {
// Splitting (setup)
int n1 = DREC_SPLIT(*n);
int n2 = *n - n1;
blasint n1 = DREC_SPLIT(*n);
blasint n2 = *n - n1;
// Work_L *
double *const Work_L = Work;
// 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);
n1 = n1_out;
// Splitting (continued)
n2 = *n - n1;
const int n_full2 = *n_full - n1;
const blasint n_full2 = *n_full - n1;
// * *
// A_BL A_BR
@ -139,23 +139,23 @@ static void RELAPACK_dsytrf_rec(
// (top recursion level: use Work as Work_BR)
double *const Work_BL = Work + 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_B
int *const ipiv_B = ipiv + n1;
blasint *const ipiv_B = ipiv + n1;
// 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);
BLAS(dgemm)("N", "T", &n_rest, &n2, &n1, MONE, A_BL_B, ldA, Work_BL, ldWork, ONE, A_BR_B, ldA);
// 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);
if (n2_out != n2) {
// undo 1 column of updates
const int n_restp1 = n_rest + 1;
const blasint n_restp1 = n_rest + 1;
// last column of A_BR
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;
} else {
// Splitting (setup)
int n2 = DREC_SPLIT(*n);
int n1 = *n - n2;
blasint n2 = DREC_SPLIT(*n);
blasint n1 = *n - n2;
// * Work_R
// (top recursion level: use Work as Work_R)
double *const Work_R = top ? Work : Work + *ldWork * n1;
// 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);
const int n2_diff = n2 - n2_out;
const blasint n2_diff = n2 - n2_out;
n2 = n2_out;
// Splitting (continued)
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 A_TR
@ -213,19 +213,19 @@ static void RELAPACK_dsytrf_rec(
// (top recursion level: Work_R was Work)
double *const Work_L = Work;
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'
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);
// 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);
if (n1_out != n1) {
// 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'
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 */
static int c__1 = 1;
static blasint c__1 = 1;
static double c_b8 = -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
* recursive algorithm.
* */
/* Subroutine */ void RELAPACK_dsytrf_rec2(char *uplo, int *n, int *
nb, int *kb, double *a, int *lda, int *ipiv,
double *w, int *ldw, int *info, ftnlen uplo_len)
/* Subroutine */ void RELAPACK_dsytrf_rec2(char *uplo, blasint *n, blasint *
nb, blasint *kb, double *a, blasint *lda, blasint *ipiv,
double *w, blasint *ldw, blasint *info, ftnlen uplo_len)
{
/* 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;
/* Builtin functions */
double sqrt(double);
/* Local variables */
static int j, k;
static blasint j, k;
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;
extern /* Subroutine */ int dscal_(int *, double *, double *,
int *);
extern /* Subroutine */ blasint dscal_(int *, double *, double *,
blasint *);
extern logical lsame_(char *, char *, ftnlen, ftnlen);
extern /* Subroutine */ int dgemv_(char *, int *, int *,
double *, double *, int *, double *, int *,
double *, double *, int *, ftnlen), dcopy_(int *,
double *, int *, double *, int *), dswap_(int
*, double *, int *, double *, int *);
static int kstep;
extern /* Subroutine */ blasint dgemv_(char *, blasint *, blasint *,
double *, double *, blasint *, double *, blasint *,
double *, double *, blasint *, ftnlen), dcopy_(int *,
double *, blasint *, double *, blasint *), dswap_(int
*, double *, blasint *, double *, blasint *);
static blasint kstep;
static double absakk;
extern int idamax_(int *, double *, int *);
extern blasint idamax_(int *, double *, blasint *);
static double colmax, rowmax;
/* Parameter adjustments */

72
relapack/src/dsytrf_rook.c
View File

@ -3,8 +3,8 @@
#include <stdlib.h>
#endif
static void RELAPACK_dsytrf_rook_rec(const char *, const int *, const int *, int *,
double *, const int *, int *, double *, const int *, int *);
static void RELAPACK_dsytrf_rook_rec(const char *, const blasint *, const blasint *, blasint *,
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.
@ -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
* */
void RELAPACK_dsytrf_rook(
const char *uplo, const int *n,
double *A, const int *ldA, int *ipiv,
double *Work, const int *lWork, int *info
const char *uplo, const blasint *n,
double *A, const blasint *ldA, blasint *ipiv,
double *Work, const blasint *lWork, blasint *info
) {
// Required work size
const int cleanlWork = *n * (*n / 2);
int minlWork = cleanlWork;
const blasint cleanlWork = *n * (*n / 2);
blasint minlWork = cleanlWork;
#if XSYTRF_ALLOW_MALLOC
minlWork = 1;
#endif
// Check arguments
const int lower = LAPACK(lsame)(uplo, "L");
const int upper = LAPACK(lsame)(uplo, "U");
const blasint lower = LAPACK(lsame)(uplo, "L");
const blasint upper = LAPACK(lsame)(uplo, "U");
*info = 0;
if (!lower && !upper)
*info = -1;
@ -55,8 +55,8 @@ void RELAPACK_dsytrf_rook(
#endif
if (*info) {
const int minfo = -*info;
LAPACK(xerbla)("DSYTRF", &minfo);
const blasint minfo = -*info;
LAPACK(xerbla)("DSYTRF", &minfo, strlen("DSYTRF"));
return;
}
@ -64,7 +64,7 @@ void RELAPACK_dsytrf_rook(
const char cleanuplo = lower ? 'L' : 'U';
// Dummy argument
int nout;
blasint nout;
// Recursive kernel
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 */
static void RELAPACK_dsytrf_rook_rec(
const char *uplo, const int *n_full, const int *n, int *n_out,
double *A, const int *ldA, int *ipiv,
double *Work, const int *ldWork, int *info
const char *uplo, const blasint *n_full, const blasint *n, blasint *n_out,
double *A, const blasint *ldA, blasint *ipiv,
double *Work, const blasint *ldWork, blasint *info
) {
// top recursion level?
const int top = *n_full == *n;
const blasint top = *n_full == *n;
if (*n <= MAX(CROSSOVER_DSYTRF_ROOK, 3)) {
// Unblocked
@ -96,31 +96,31 @@ static void RELAPACK_dsytrf_rook_rec(
return;
}
int info1, info2;
blasint info1, info2;
// Constants
const double ONE[] = { 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') {
// Splitting (setup)
int n1 = DREC_SPLIT(*n);
int n2 = *n - n1;
blasint n1 = DREC_SPLIT(*n);
blasint n2 = *n - n1;
// Work_L *
double *const Work_L = Work;
// 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);
n1 = n1_out;
// Splitting (continued)
n2 = *n - n1;
const int n_full2 = *n_full - n1;
const blasint n_full2 = *n_full - n1;
// * *
// A_BL A_BR
@ -136,23 +136,23 @@ static void RELAPACK_dsytrf_rook_rec(
// (top recursion level: use Work as Work_BR)
double *const Work_BL = Work + 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_B
int *const ipiv_B = ipiv + n1;
blasint *const ipiv_B = ipiv + n1;
// 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);
BLAS(dgemm)("N", "T", &n_rest, &n2, &n1, MONE, A_BL_B, ldA, Work_BL, ldWork, ONE, A_BR_B, ldA);
// 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);
if (n2_out != n2) {
// undo 1 column of updates
const int n_restp1 = n_rest + 1;
const blasint n_restp1 = n_rest + 1;
// last column of A_BR
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;
// shift pivots
int i;
blasint i;
for (i = 0; i < n2; i++)
if (ipiv_B[i] > 0)
ipiv_B[i] += n1;
@ -180,22 +180,22 @@ static void RELAPACK_dsytrf_rook_rec(
*n_out = n1 + n2;
} else {
// Splitting (setup)
int n2 = DREC_SPLIT(*n);
int n1 = *n - n2;
blasint n2 = DREC_SPLIT(*n);
blasint n1 = *n - n2;
// * Work_R
// (top recursion level: use Work as Work_R)
double *const Work_R = top ? Work : Work + *ldWork * n1;
// 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);
const int n2_diff = n2 - n2_out;
const blasint n2_diff = n2 - n2_out;
n2 = n2_out;
// Splitting (continued)
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 A_TR
@ -211,19 +211,19 @@ static void RELAPACK_dsytrf_rook_rec(
// (top recursion level: Work_R was Work)
double *const Work_L = Work;
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'
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);
// 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);
if (n1_out != n1) {
// 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'
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 */
static int c__1 = 1;
static blasint c__1 = 1;
static double c_b9 = -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
* recursive algorithm.
* */
/* Subroutine */ void RELAPACK_dsytrf_rook_rec2(char *uplo, int *n,
int *nb, int *kb, double *a, int *lda, int *ipiv,
double *w, int *ldw, int *info, ftnlen uplo_len)
/* Subroutine */ void RELAPACK_dsytrf_rook_rec2(char *uplo, blasint *n,
int *nb, blasint *kb, double *a, blasint *lda, blasint *ipiv,
double *w, blasint *ldw, blasint *info, ftnlen uplo_len)
{
/* 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;
/* Builtin functions */
double sqrt(double);
/* Local variables */
static int j, k, p;
static blasint j, k, p;
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 int imax, jmax;
static blasint imax, jmax;
static double alpha;
extern /* Subroutine */ int dscal_(int *, double *, double *,
int *);
extern /* Subroutine */ blasint dscal_(int *, double *, double *,
blasint *);
extern logical lsame_(char *, char *, ftnlen, ftnlen);
extern /* Subroutine */ int dgemv_(char *, int *, int *,
double *, double *, int *, double *, int *,
double *, double *, int *, ftnlen);
extern /* Subroutine */ blasint dgemv_(char *, blasint *, blasint *,
double *, double *, blasint *, double *, blasint *,
double *, double *, blasint *, ftnlen);
static double dtemp, sfmin;
static int itemp;
extern /* Subroutine */ int dcopy_(int *, double *, int *,
double *, int *), dswap_(int *, double *, int
*, double *, int *);
static int kstep;
static blasint itemp;
extern /* Subroutine */ blasint dcopy_(int *, double *, blasint *,
double *, blasint *), dswap_(int *, double *, int
*, double *, blasint *);
static blasint kstep;
extern double dlamch_(char *, ftnlen);
static double absakk;
extern int idamax_(int *, double *, int *);
extern blasint idamax_(int *, double *, blasint *);
static double colmax, rowmax;
/* Parameter adjustments */

66
relapack/src/dtgsyl.c
View File

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

56
relapack/src/dtrsyl.c
View File

@ -1,8 +1,8 @@
#include "relapack.h"
static void RELAPACK_dtrsyl_rec(const char *, const char *, const int *,
const int *, const int *, const double *, const int *, const double *,
const int *, double *, const int *, double *, int *);
static void RELAPACK_dtrsyl_rec(const char *, const char *, const blasint *,
const blasint *, const blasint *, const double *, const blasint *, const double *,
const blasint *, double *, const blasint *, double *, blasint *);
/** 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
* */
void RELAPACK_dtrsyl(
const char *tranA, const char *tranB, const int *isgn,
const int *m, const int *n,
const double *A, const int *ldA, const double *B, const int *ldB,
double *C, const int *ldC, double *scale,
int *info
const char *tranA, const char *tranB, const blasint *isgn,
const blasint *m, const blasint *n,
const double *A, const blasint *ldA, const double *B, const blasint *ldB,
double *C, const blasint *ldC, double *scale,
blasint *info
) {
// Check arguments
const int notransA = LAPACK(lsame)(tranA, "N");
const int transA = LAPACK(lsame)(tranA, "T");
const int ctransA = LAPACK(lsame)(tranA, "C");
const int notransB = LAPACK(lsame)(tranB, "N");
const int transB = LAPACK(lsame)(tranB, "T");
const int ctransB = LAPACK(lsame)(tranB, "C");
const blasint notransA = LAPACK(lsame)(tranA, "N");
const blasint transA = LAPACK(lsame)(tranA, "T");
const blasint ctransA = LAPACK(lsame)(tranA, "C");
const blasint notransB = LAPACK(lsame)(tranB, "N");
const blasint transB = LAPACK(lsame)(tranB, "T");
const blasint ctransB = LAPACK(lsame)(tranB, "C");
*info = 0;
if (!transA && !ctransA && !notransA)
*info = -1;
@ -44,8 +44,8 @@ void RELAPACK_dtrsyl(
else if (*ldC < MAX(1, *m))
*info = -11;
if (*info) {
const int minfo = -*info;
LAPACK(xerbla)("DTRSYL", &minfo);
const blasint minfo = -*info;
LAPACK(xerbla)("DTRSYL", &minfo, strlen("DTRSYL"));
return;
}
@ -60,11 +60,11 @@ void RELAPACK_dtrsyl(
/** dtrsyl's recursive compute kernel */
static void RELAPACK_dtrsyl_rec(
const char *tranA, const char *tranB, const int *isgn,
const int *m, const int *n,
const double *A, const int *ldA, const double *B, const int *ldB,
double *C, const int *ldC, double *scale,
int *info
const char *tranA, const char *tranB, const blasint *isgn,
const blasint *m, const blasint *n,
const double *A, const blasint *ldA, const double *B, const blasint *ldB,
double *C, const blasint *ldC, double *scale,
blasint *info
) {
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 MONE[] = { -1. };
const double MSGN[] = { -*isgn };
const int iONE[] = { 1 };
const blasint iONE[] = { 1 };
// Outputs
double scale1[] = { 1. };
double scale2[] = { 1. };
int info1[] = { 0 };
int info2[] = { 0 };
blasint info1[] = { 0 };
blasint info2[] = { 0 };
if (*m > *n) {
// Splitting
int m1 = DREC_SPLIT(*m);
blasint m1 = DREC_SPLIT(*m);
if (A[m1 + *ldA * (m1 - 1)])
m1++;
const int m2 = *m - m1;
const blasint m2 = *m - m1;
// A_TL A_TR
// 0 A_BR
@ -126,10 +126,10 @@ static void RELAPACK_dtrsyl_rec(
}
} else {
// Splitting
int n1 = DREC_SPLIT(*n);
blasint n1 = DREC_SPLIT(*n);
if (B[n1 + *ldB * (n1 - 1)])
n1++;
const int n2 = *n - n1;
const blasint n2 = *n - n1;
// B_TL B_TR
// 0 B_BR

58
relapack/src/dtrsyl_rec2.c
View File

@ -14,52 +14,52 @@
/* Table of constant values */
static int c__1 = 1;
static int c_false = FALSE_;
static int c__2 = 2;
static blasint c__1 = 1;
static blasint c_false = FALSE_;
static blasint c__2 = 2;
static double c_b26 = 1.;
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
*m, int *n, double *a, int *lda, double *b, int *
ldb, double *c__, int *ldc, double *scale, int *info,
int RELAPACK_dtrsyl_rec2(char *trana, char *tranb, blasint *isgn, int
*m, blasint *n, double *a, blasint *lda, double *b, blasint *
ldb, double *c__, blasint *ldc, double *scale, blasint *info,
ftnlen trana_len, ftnlen tranb_len)
{
/* 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;
double d__1, d__2;
/* Local variables */
static int j, k, l;
static blasint j, k, l;
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,
sgn;
extern double ddot_(int *, double *, int *, double *,
int *);
static int ierr;
extern double ddot_(int *, double *, blasint *, double *,
blasint *);
static blasint ierr;
static double smin, suml, sumr;
extern /* Subroutine */ int dscal_(int *, double *, double *,
int *);
extern int lsame_(char *, char *, ftnlen, ftnlen);
static int knext, lnext;
extern /* Subroutine */ blasint dscal_(int *, double *, double *,
blasint *);
extern blasint lsame_(char *, char *, ftnlen, ftnlen);
static blasint knext, lnext;
static double xnorm;
extern /* Subroutine */ int dlaln2_(int *, int *, int *,
double *, double *, double *, int *, double *,
double *, double *, int *, double *, double *
, double *, int *, double *, double *, int *),
dlasy2_(int *, int *, int *, int *, int *,
double *, int *, double *, int *, double *,
int *, double *, double *, int *, double *,
int *), dlabad_(double *, double *);
extern double dlamch_(char *, ftnlen), dlange_(char *, int *,
int *, double *, int *, double *, ftnlen);
extern /* Subroutine */ blasint dlaln2_(int *, blasint *, blasint *,
double *, double *, double *, blasint *, double *,
double *, double *, blasint *, double *, double *
, double *, blasint *, double *, double *, blasint *),
dlasy2_(int *, blasint *, blasint *, blasint *, blasint *,
double *, blasint *, double *, blasint *, double *,
blasint *, double *, double *, blasint *, double *,
blasint *), dlabad_(double *, double *);
extern double dlamch_(char *, ftnlen), dlange_(char *, blasint *,
blasint *, double *, blasint *, double *, ftnlen);
static double scaloc;
extern /* Subroutine */ int xerbla_(char *, int *, ftnlen);
extern /* Subroutine */ blasint xerbla_(char *, blasint *, ftnlen);
static double bignum;
static int notrna, notrnb;
static blasint notrna, notrnb;
static double smlnum;
/* Parameter adjustments */

34
relapack/src/dtrtri.c
View File

@ -1,7 +1,7 @@
#include "relapack.h"
static void RELAPACK_dtrtri_rec(const char *, const char *, const int *,
double *, const int *, int *);
static void RELAPACK_dtrtri_rec(const char *, const char *, const blasint *,
double *, const blasint *, blasint *);
/** 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
* */
void RELAPACK_dtrtri(
const char *uplo, const char *diag, const int *n,
double *A, const int *ldA,
int *info
const char *uplo, const char *diag, const blasint *n,
double *A, const blasint *ldA,
blasint *info
) {
// Check arguments
const int lower = LAPACK(lsame)(uplo, "L");
const int upper = LAPACK(lsame)(uplo, "U");
const int nounit = LAPACK(lsame)(diag, "N");
const int unit = LAPACK(lsame)(diag, "U");
const blasint lower = LAPACK(lsame)(uplo, "L");
const blasint upper = LAPACK(lsame)(uplo, "U");
const blasint nounit = LAPACK(lsame)(diag, "N");
const blasint unit = LAPACK(lsame)(diag, "U");
*info = 0;
if (!lower && !upper)
*info = -1;
@ -31,8 +31,8 @@ void RELAPACK_dtrtri(
else if (*ldA < MAX(1, *n))
*info = -5;
if (*info) {
const int minfo = -*info;
LAPACK(xerbla)("DTRTRI", &minfo);
const blasint minfo = -*info;
LAPACK(xerbla)("DTRTRI", &minfo, strlen("DTRTRI"));
return;
}
@ -42,7 +42,7 @@ void RELAPACK_dtrtri(
// check for singularity
if (nounit) {
int i;
blasint i;
for (i = 0; i < *n; i++)
if (A[i + *ldA * i] == 0) {
*info = i;
@ -57,9 +57,9 @@ void RELAPACK_dtrtri(
/** dtrtri's recursive compute kernel */
static void RELAPACK_dtrtri_rec(
const char *uplo, const char *diag, const int *n,
double *A, const int *ldA,
int *info
const char *uplo, const char *diag, const blasint *n,
double *A, const blasint *ldA,
blasint *info
){
if (*n <= MAX(CROSSOVER_DTRTRI, 1)) {
@ -73,8 +73,8 @@ static void RELAPACK_dtrtri_rec(
const double MONE[] = { -1. };
// Splitting
const int n1 = DREC_SPLIT(*n);
const int n2 = *n - n1;
const blasint n1 = DREC_SPLIT(*n);
const blasint n2 = *n - n1;
// A_TL A_TR
// A_BL A_BR

2
relapack/src/f2c.c
View File

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

13
relapack/src/f2c.h
View File

@ -7,6 +7,19 @@
#ifndef 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 unsigned long int uinteger;
typedef char *address;

124
relapack/src/lapack.h
View File

@ -1,80 +1,80 @@
#ifndef LAPACK_H
#define LAPACK_H
extern int LAPACK(lsame)(const char *, const char *);
extern int LAPACK(xerbla)(const char *, const int *);
extern blasint LAPACK(lsame)(const char *, const char *);
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(dlaswp)(const int *, double *, const int *, const int *, const int *, const int *, const int *);
extern void LAPACK(claswp)(const int *, float *, const int *, const int *, const int *, const int *, const int *);
extern void LAPACK(zlaswp)(const int *, double *, 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 blasint *, double *, const blasint *, const blasint *, const blasint *, const blasint *, const blasint *);
extern void LAPACK(claswp)(const blasint *, float *, const blasint *, const blasint *, const blasint *, const blasint *, const blasint *);
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(dlaset)(const char *, const int *, const int *, const double *, const double *, double *, const int *);
extern void LAPACK(claset)(const char *, const int *, const int *, const float *, const float *, float *, const int *);
extern void LAPACK(zlaset)(const char *, const int *, const int *, const double *, const double *, double *, 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 blasint *, const blasint *, const double *, const double *, double *, const blasint *);
extern void LAPACK(claset)(const char *, const blasint *, const blasint *, const float *, const float *, float *, const blasint *);
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(dlacpy)(const char *, const int *, const int *, const double *, const int *, double *, const int *);
extern void LAPACK(clacpy)(const char *, const int *, const int *, const float *, const int *, float *, const int *);
extern void LAPACK(zlacpy)(const char *, const int *, const int *, const double *, const int *, double *, 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 blasint *, const blasint *, const double *, const blasint *, double *, const blasint *);
extern void LAPACK(clacpy)(const char *, const blasint *, const blasint *, const float *, const blasint *, float *, const blasint *);
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(dlascl)(const char *, const int *, const int *, const double *, const double *, const int *, const int *, double *, const int *, int *);
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(zlascl)(const char *, const int *, const int *, const double *, const double *, const int *, const int *, double *, 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 blasint *, const blasint *, const double *, const double *, const blasint *, const blasint *, double *, const blasint *, blasint *);
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 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(dlauu2)(const char *, const int *, double *, const int *, int *);
extern void LAPACK(clauu2)(const char *, const int *, float *, const int *, int *);
extern void LAPACK(zlauu2)(const char *, const int *, double *, const int *, int *);
extern void LAPACK(slauu2)(const char *, const blasint *, float *, const blasint *, blasint *);
extern void LAPACK(dlauu2)(const char *, const blasint *, double *, const blasint *, blasint *);
extern void LAPACK(clauu2)(const char *, const blasint *, float *, const blasint *, blasint *);
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(dsygs2)(const int *, const char *, const int *, double *, const int *, const double *, const int *, int *);
extern void LAPACK(chegs2)(const int *, const char *, const int *, float *, const int *, const float *, const int *, int *);
extern void LAPACK(zhegs2)(const int *, const char *, const int *, double *, const int *, const double *, 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 blasint *, const char *, const blasint *, double *, const blasint *, const double *, const blasint *, blasint *);
extern void LAPACK(chegs2)(const blasint *, const char *, const blasint *, float *, const blasint *, const float *, const blasint *, blasint *);
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(dtrti2)(const char *, const char *, const int *, double *, const int *, int *);
extern void LAPACK(ctrti2)(const char *, const char *, const int *, float *, const int *, int *);
extern void LAPACK(ztrti2)(const char *, const char *, const int *, double *, 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 blasint *, double *, const blasint *, blasint *);
extern void LAPACK(ctrti2)(const char *, const char *, const blasint *, float *, const blasint *, blasint *);
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(dpotf2)(const char *, const int *, double *, const int *, int *);
extern void LAPACK(cpotf2)(const char *, const int *, float *, const int *, int *);
extern void LAPACK(zpotf2)(const char *, const int *, double *, const int *, int *);
extern void LAPACK(spotf2)(const char *, const blasint *, float *, const blasint *, blasint *);
extern void LAPACK(dpotf2)(const char *, const blasint *, double *, const blasint *, blasint *);
extern void LAPACK(cpotf2)(const char *, const blasint *, float *, const blasint *, blasint *);
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(dpbtf2)(const char *, const int *, const int *, double *, const int *, int *);
extern void LAPACK(cpbtf2)(const char *, const int *, const int *, float *, const int *, int *);
extern void LAPACK(zpbtf2)(const char *, const int *, const int *, double *, const int *, int *);
extern void LAPACK(spbtf2)(const char *, const blasint *, const blasint *, float *, const blasint *, blasint *);
extern void LAPACK(dpbtf2)(const char *, const blasint *, const blasint *, double *, const blasint *, blasint *);
extern void LAPACK(cpbtf2)(const char *, const blasint *, const blasint *, float *, const blasint *, blasint *);
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(dsytf2)(const char *, const int *, double *, const int *, int *, int *);
extern void LAPACK(csytf2)(const char *, const int *, float *, const int *, int *, int *);
extern void LAPACK(chetf2)(const char *, const int *, float *, const int *, int *, int *);
extern void LAPACK(zsytf2)(const char *, const int *, double *, const int *, int *, int *);
extern void LAPACK(zhetf2)(const char *, const int *, double *, const int *, int *, int *);
extern void LAPACK(ssytf2_rook)(const char *, const int *, float *, const int *, int *, int *);
extern void LAPACK(dsytf2_rook)(const char *, const int *, double *, const int *, int *, int *);
extern void LAPACK(csytf2_rook)(const char *, const int *, float *, const int *, int *, int *);
extern void LAPACK(chetf2_rook)(const char *, const int *, float *, const int *, int *, int *);
extern void LAPACK(zsytf2_rook)(const char *, const int *, double *, const int *, int *, int *);
extern void LAPACK(zhetf2_rook)(const char *, const int *, double *, const int *, int *, int *);
extern void LAPACK(ssytf2)(const char *, const blasint *, float *, const blasint *, blasint *, blasint *);
extern void LAPACK(dsytf2)(const char *, const blasint *, double *, const blasint *, blasint *, blasint *);
extern void LAPACK(csytf2)(const char *, const blasint *, float *, const blasint *, blasint *, blasint *);
extern void LAPACK(chetf2)(const char *, const blasint *, float *, const blasint *, blasint *, blasint *);
extern void LAPACK(zsytf2)(const char *, const blasint *, double *, const blasint *, blasint *, blasint *);
extern void LAPACK(zhetf2)(const char *, const blasint *, double *, const blasint *, blasint *, blasint *);
extern void LAPACK(ssytf2_rook)(const char *, const blasint *, float *, const blasint *, blasint *, blasint *);
extern void LAPACK(dsytf2_rook)(const char *, const blasint *, double *, const blasint *, blasint *, blasint *);
extern void LAPACK(csytf2_rook)(const char *, const blasint *, float *, const blasint *, blasint *, blasint *);
extern void LAPACK(chetf2_rook)(const char *, const blasint *, float *, const blasint *, blasint *, blasint *);
extern void LAPACK(zsytf2_rook)(const char *, const blasint *, double *, const blasint *, blasint *, blasint *);
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(dgetf2)(const int *, const int *, double *, const int *, int *, int *);
extern void LAPACK(cgetf2)(const int *, const int *, float *, const int *, int *, int *);
extern void LAPACK(zgetf2)(const int *, const int *, double *, const int *, int *, int *);
extern void LAPACK(sgetf2)(const blasint *, const blasint *, float *, const blasint *, blasint *, blasint *);
extern void LAPACK(dgetf2)(const blasint *, const blasint *, double *, const blasint *, blasint *, blasint *);
extern void LAPACK(cgetf2)(const blasint *, const blasint *, float *, const blasint *, blasint *, blasint *);
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(dgbtf2)(const int *, const int *, const int *, const int *, double *, const int *, int *, int *);
extern void LAPACK(cgbtf2)(const int *, const int *, const int *, const int *, float *, const int *, int *, int *);
extern void LAPACK(zgbtf2)(const int *, const int *, const int *, const int *, double *, 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 blasint *, const blasint *, const blasint *, const blasint *, double *, const blasint *, blasint *, blasint *);
extern void LAPACK(cgbtf2)(const blasint *, const blasint *, const blasint *, const blasint *, float *, const blasint *, blasint *, blasint *);
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(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(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(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(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 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 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 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 */

360
relapack/src/lapack_wrappers.c
View File

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

42
relapack/src/relapack.h
View File

@ -1,6 +1,14 @@
#ifndef 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 "../inc/relapack.h"
@ -38,23 +46,23 @@
#include "blas.h"
// sytrf helper routines
void RELAPACK_ssytrf_rec2(const char *, const int *, const int *, int *, float *, const int *, int *, float *, const int *, int *);
void RELAPACK_dsytrf_rec2(const char *, const int *, const int *, int *, double *, const int *, int *, double *, const int *, int *);
void RELAPACK_csytrf_rec2(const char *, const int *, const int *, int *, float *, const int *, int *, float *, const int *, int *);
void RELAPACK_chetrf_rec2(const char *, const int *, const int *, int *, float *, const int *, int *, float *, const int *, int *);
void RELAPACK_zsytrf_rec2(const char *, const int *, const int *, int *, double *, const int *, int *, double *, const int *, int *);
void RELAPACK_zhetrf_rec2(const char *, const int *, const int *, int *, double *, const int *, int *, double *, const int *, int *);
void RELAPACK_ssytrf_rook_rec2(const char *, const int *, const int *, int *, float *, const int *, int *, float *, const int *, int *);
void RELAPACK_dsytrf_rook_rec2(const char *, const int *, const int *, int *, double *, const int *, int *, double *, const int *, int *);
void RELAPACK_csytrf_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 int *, const int *, int *, float *, const int *, int *, float *, const int *, int *);
void RELAPACK_zsytrf_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 int *, const int *, int *, double *, const int *, int *, double *, 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 blasint *, const blasint *, blasint *, double *, const blasint *, blasint *, double *, const blasint *, blasint *);
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 blasint *, const blasint *, blasint *, float *, const blasint *, blasint *, float *, const blasint *, blasint *);
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 blasint *, const blasint *, blasint *, double *, const blasint *, blasint *, double *, const blasint *, blasint *);
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 blasint *, const blasint *, blasint *, double *, const blasint *, blasint *, double *, const blasint *, blasint *);
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 blasint *, const blasint *, blasint *, float *, const blasint *, blasint *, float *, const blasint *, blasint *);
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 blasint *, const blasint *, blasint *, double *, const blasint *, blasint *, double *, const blasint *, blasint *);
// 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_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_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_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_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 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 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 blasint *, const blasint *, const blasint *, const double *, const blasint *, const double *, const blasint *, double *, const blasint *, double *, blasint *);
#endif /* RELAPACK_INT_H */

79
relapack/src/sgbtrf.c
View File

@ -1,9 +1,9 @@
#include "relapack.h"
#include "stdlib.h"
static void RELAPACK_sgbtrf_rec(const int *, const int *, const int *,
const int *, float *, const int *, int *, float *, const int *, float *,
const int *, int *);
static void RELAPACK_sgbtrf_rec(const blasint *, const blasint *, const blasint *,
const blasint *, float *, const blasint *, blasint *, float *, const blasint *, float *,
const blasint *, blasint *);
/** 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
* */
void RELAPACK_sgbtrf(
const int *m, const int *n, const int *kl, const int *ku,
float *Ab, const int *ldAb, int *ipiv,
int *info
const blasint *m, const blasint *n, const blasint *kl, const blasint *ku,
float *Ab, const blasint *ldAb, blasint *ipiv,
blasint *info
) {
// Check arguments
*info = 0;
if (*m < 0)
@ -31,8 +30,8 @@ void RELAPACK_sgbtrf(
else if (*ldAb < 2 * *kl + *ku + 1)
*info = -6;
if (*info) {
const int minfo = -*info;
LAPACK(xerbla)("SGBTRF", &minfo);
const blasint minfo = -*info;
LAPACK(xerbla)("SGBTRF", &minfo, strlen("SGBTRF"));
return;
}
@ -40,14 +39,14 @@ void RELAPACK_sgbtrf(
const float ZERO[] = { 0. };
// Result upper band width
const int kv = *ku + *kl;
const blasint kv = *ku + *kl;
// Unskewg A
const int ldA[] = { *ldAb - 1 };
const blasint ldA[] = { *ldAb - 1 };
float *const A = Ab + kv;
// Zero upper diagonal fill-in elements
int i, j;
blasint i, j;
for (j = 0; j < *n; j++) {
float *const A_j = A + *ldA * j;
for (i = MAX(0, j - kv); i < j - *ku; i++)
@ -55,11 +54,11 @@ void RELAPACK_sgbtrf(
}
// Allocate work space
const int n1 = SREC_SPLIT(*n);
const int mWorkl = (kv > n1) ? MAX(1, *m - *kl) : kv;
const int nWorkl = (kv > n1) ? n1 : kv;
const int mWorku = (*kl > n1) ? n1 : *kl;
const int nWorku = (*kl > n1) ? MAX(0, *n - *kl) : *kl;
const blasint n1 = SREC_SPLIT(*n);
const blasint mWorkl = (kv > n1) ? MAX(1, *m - *kl) : kv;
const blasint nWorkl = (kv > n1) ? n1 : kv;
const blasint mWorku = (*kl > n1) ? n1 : *kl;
const blasint nWorku = (*kl > n1) ? MAX(0, *n - *kl) : *kl;
float *Workl = malloc(mWorkl * nWorkl * sizeof(float));
float *Worku = malloc(mWorku * nWorku * sizeof(float));
LAPACK(slaset)("L", &mWorkl, &nWorkl, ZERO, ZERO, Workl, &mWorkl);
@ -76,10 +75,10 @@ void RELAPACK_sgbtrf(
/** sgbtrf's recursive compute kernel */
static void RELAPACK_sgbtrf_rec(
const int *m, const int *n, const int *kl, const int *ku,
float *Ab, const int *ldAb, int *ipiv,
float *Workl, const int *ldWorkl, float *Worku, const int *ldWorku,
int *info
const blasint *m, const blasint *n, const blasint *kl, const blasint *ku,
float *Ab, const blasint *ldAb, blasint *ipiv,
float *Workl, const blasint *ldWorkl, float *Worku, const blasint *ldWorku,
blasint *info
) {
if (*n <= MAX(CROSSOVER_SGBTRF, 1)) {
@ -91,25 +90,25 @@ static void RELAPACK_sgbtrf_rec(
// Constants
const float ONE[] = { 1. };
const float MONE[] = { -1. };
const int iONE[] = { 1 };
const blasint iONE[] = { 1 };
// Loop iterators
int i, j;
blasint i, j;
// Output upper band width
const int kv = *ku + *kl;
const blasint kv = *ku + *kl;
// Unskew A
const int ldA[] = { *ldAb - 1 };
const blasint ldA[] = { *ldAb - 1 };
float *const A = Ab + kv;
// Splitting
const int n1 = MIN(SREC_SPLIT(*n), *kl);
const int n2 = *n - n1;
const int m1 = MIN(n1, *m);
const int m2 = *m - m1;
const int mn1 = MIN(m1, n1);
const int mn2 = MIN(m2, n2);
const blasint n1 = MIN(SREC_SPLIT(*n), *kl);
const blasint n2 = *n - n1;
const blasint m1 = MIN(n1, *m);
const blasint m2 = *m - m1;
const blasint mn1 = MIN(m1, n1);
const blasint mn2 = MIN(m2, n2);
// Ab_L *
// Ab_BR
@ -129,14 +128,14 @@ static void RELAPACK_sgbtrf_rec(
// ipiv_T
// ipiv_B
int *const ipiv_T = ipiv;
int *const ipiv_B = ipiv + n1;
blasint *const ipiv_T = ipiv;
blasint *const ipiv_B = ipiv + n1;
// Banded splitting
const int n21 = MIN(n2, kv - n1);
const int n22 = MIN(n2 - n21, n1);
const int m21 = MIN(m2, *kl - m1);
const int m22 = MIN(m2 - m21, m1);
const blasint n21 = MIN(n2, kv - n1);
const blasint n22 = MIN(n2 - n21, n1);
const blasint m21 = MIN(m2, *kl - m1);
const blasint m22 = MIN(m2 - m21, m1);
// n1 n21 n22
// m * A_Rl ARr
@ -164,7 +163,7 @@ static void RELAPACK_sgbtrf_rec(
// partially redo swaps in A_L
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 < *kl)
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++) {
float *const A_Rrj = A_Rr + *ldA * j;
for (i = j; i < mn1; i++) {
const int ip = ipiv_T[i] - 1;
const blasint ip = ipiv_T[i] - 1;
if (ip != i) {
const float tmp = A_Rrj[i];
A_Rrj[i] = A_Rr[ip];
@ -208,7 +207,7 @@ static void RELAPACK_sgbtrf_rec(
// partially undo swaps in A_L
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 < *kl)
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"
static void RELAPACK_sgemmt_rec(const char *, const char *, const char *,
const int *, const int *, const float *, const float *, const int *,
const float *, const int *, const float *, float *, const int *);
const blasint *, const blasint *, const float *, const float *, const blasint *,
const float *, const blasint *, const float *, float *, const blasint *);
static void RELAPACK_sgemmt_rec2(const char *, const char *, const char *,
const int *, const int *, const float *, const float *, const int *,
const float *, const int *, const float *, float *, const int *);
const blasint *, const blasint *, const float *, const float *, const blasint *,
const float *, const blasint *, const float *, float *, const blasint *);
/** 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(
const char *uplo, const char *transA, const char *transB,
const int *n, const int *k,
const float *alpha, const float *A, const int *ldA,
const float *B, const int *ldB,
const float *beta, float *C, const int *ldC
const blasint *n, const blasint *k,
const float *alpha, const float *A, const blasint *ldA,
const float *B, const blasint *ldB,
const float *beta, float *C, const blasint *ldC
) {
#if HAVE_XGEMMT
@ -32,13 +32,13 @@ void RELAPACK_sgemmt(
#else
// Check arguments
const int lower = LAPACK(lsame)(uplo, "L");
const int upper = LAPACK(lsame)(uplo, "U");
const int notransA = LAPACK(lsame)(transA, "N");
const int tranA = LAPACK(lsame)(transA, "T");
const int notransB = LAPACK(lsame)(transB, "N");
const int tranB = LAPACK(lsame)(transB, "T");
int info = 0;
const blasint lower = LAPACK(lsame)(uplo, "L");
const blasint upper = LAPACK(lsame)(uplo, "U");
const blasint notransA = LAPACK(lsame)(transA, "N");
const blasint tranA = LAPACK(lsame)(transA, "T");
const blasint notransB = LAPACK(lsame)(transB, "N");
const blasint tranB = LAPACK(lsame)(transB, "T");
blasint info = 0;
if (!lower && !upper)
info = 1;
else if (!tranA && !notransA)
@ -56,7 +56,7 @@ void RELAPACK_sgemmt(
else if (*ldC < MAX(1, *n))
info = 13;
if (info) {
LAPACK(xerbla)("SGEMMT", &info);
LAPACK(xerbla)("SGEMMT", &info, strlen("SGEMMT"));
return;
}
@ -74,10 +74,10 @@ void RELAPACK_sgemmt(
/** sgemmt's recursive compute kernel */
static void RELAPACK_sgemmt_rec(
const char *uplo, const char *transA, const char *transB,
const int *n, const int *k,
const float *alpha, const float *A, const int *ldA,
const float *B, const int *ldB,
const float *beta, float *C, const int *ldC
const blasint *n, const blasint *k,
const float *alpha, const float *A, const blasint *ldA,
const float *B, const blasint *ldB,
const float *beta, float *C, const blasint *ldC
) {
if (*n <= MAX(CROSSOVER_SGEMMT, 1)) {
@ -87,8 +87,8 @@ static void RELAPACK_sgemmt_rec(
}
// Splitting
const int n1 = SREC_SPLIT(*n);
const int n2 = *n - n1;
const blasint n1 = SREC_SPLIT(*n);
const blasint n2 = *n - n1;
// A_T
// A_B
@ -124,16 +124,16 @@ static void RELAPACK_sgemmt_rec(
/** sgemmt's unblocked compute kernel */
static void RELAPACK_sgemmt_rec2(
const char *uplo, const char *transA, const char *transB,
const int *n, const int *k,
const float *alpha, const float *A, const int *ldA,
const float *B, const int *ldB,
const float *beta, float *C, const int *ldC
const blasint *n, const blasint *k,
const float *alpha, const float *A, const blasint *ldA,
const float *B, const blasint *ldB,
const float *beta, float *C, const blasint *ldC
) {
const int incB = (*transB == 'N') ? 1 : *ldB;
const int incC = 1;
const blasint incB = (*transB == 'N') ? 1 : *ldB;
const blasint incC = 1;
int i;
blasint i;
for (i = 0; i < *n; i++) {
// A_0
// A_i
@ -149,13 +149,13 @@ static void RELAPACK_sgemmt_rec2(
float *const C_ii = C + *ldC * i + i;
if (*uplo == 'L') {
const int nmi = *n - i;
const blasint nmi = *n - i;
if (*transA == 'N')
BLAS(sgemv)(transA, &nmi, k, alpha, A_i, ldA, B_i, &incB, beta, C_ii, &incC);
else
BLAS(sgemv)(transA, k, &nmi, alpha, A_i, ldA, B_i, &incB, beta, C_ii, &incC);
} else {
const int ip1 = i + 1;
const blasint ip1 = i + 1;
if (*transA == 'N')
BLAS(sgemv)(transA, &ip1, k, alpha, A_0, ldA, B_i, &incB, beta, C_0i, &incC);
else

40
relapack/src/sgetrf.c
View File

@ -1,7 +1,7 @@
#include "relapack.h"
static void RELAPACK_sgetrf_rec(const int *, const int *, float *, const int *,
int *, int *);
static void RELAPACK_sgetrf_rec(const blasint *, const blasint *, float *, const blasint *,
blasint *, blasint *);
/** 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
* */
void RELAPACK_sgetrf(
const int *m, const int *n,
float *A, const int *ldA, int *ipiv,
int *info
const blasint *m, const blasint *n,
float *A, const blasint *ldA, blasint *ipiv,
blasint *info
) {
// Check arguments
@ -25,12 +25,12 @@ void RELAPACK_sgetrf(
else if (*ldA < MAX(1, *n))
*info = -4;
if (*info) {
const int minfo = -*info;
LAPACK(xerbla)("SGETRF", &minfo);
const blasint minfo = -*info;
LAPACK(xerbla)("SGETRF", &minfo, strlen("SGETRF"));
return;
}
const int sn = MIN(*m, *n);
const blasint sn = MIN(*m, *n);
RELAPACK_sgetrf_rec(m, &sn, A, ldA, ipiv, info);
@ -38,10 +38,10 @@ void RELAPACK_sgetrf(
if (*m < *n) {
// Constants
const float ONE[] = { 1. };
const int iONE[] = { 1. };
const blasint iONE[] = { 1. };
// Splitting
const int rn = *n - *m;
const blasint rn = *n - *m;
// A_L A_R
const float *const A_L = A;
@ -57,9 +57,9 @@ void RELAPACK_sgetrf(
/** sgetrf's recursive compute kernel */
static void RELAPACK_sgetrf_rec(
const int *m, const int *n,
float *A, const int *ldA, int *ipiv,
int *info
const blasint *m, const blasint *n,
float *A, const blasint *ldA, blasint *ipiv,
blasint *info
) {
if (*n <= MAX(CROSSOVER_SGETRF, 1)) {
@ -71,12 +71,12 @@ static void RELAPACK_sgetrf_rec(
// Constants
const float ONE[] = { 1. };
const float MONE[] = { -1. };
const int iONE[] = { 1 };
const blasint iONE[] = { 1 };
// Splitting
const int n1 = SREC_SPLIT(*n);
const int n2 = *n - n1;
const int m2 = *m - n1;
const blasint n1 = SREC_SPLIT(*n);
const blasint n2 = *n - n1;
const blasint m2 = *m - n1;
// A_L A_R
float *const A_L = A;
@ -91,8 +91,8 @@ static void RELAPACK_sgetrf_rec(
// ipiv_T
// ipiv_B
int *const ipiv_T = ipiv;
int *const ipiv_B = ipiv + n1;
blasint *const ipiv_T = ipiv;
blasint *const ipiv_B = ipiv + n1;
// recursion(A_L, ipiv_T)
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
LAPACK(slaswp)(&n1, A_BL, ldA, iONE, &n2, ipiv_B, iONE);
// shift pivots
int i;
blasint i;
for (i = 0; i < n2; i++)
ipiv_B[i] += n1;
}

28
relapack/src/slauum.c
View File

@ -1,7 +1,7 @@
#include "relapack.h"
static void RELAPACK_slauum_rec(const char *, const int *, float *,
const int *, int *);
static void RELAPACK_slauum_rec(const char *, const blasint *, float *,
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.
@ -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
* */
void RELAPACK_slauum(
const char *uplo, const int *n,
float *A, const int *ldA,
int *info
const char *uplo, const blasint *n,
float *A, const blasint *ldA,
blasint *info
) {
// Check arguments
const int lower = LAPACK(lsame)(uplo, "L");
const int upper = LAPACK(lsame)(uplo, "U");
const blasint lower = LAPACK(lsame)(uplo, "L");
const blasint upper = LAPACK(lsame)(uplo, "U");
*info = 0;
if (!lower && !upper)
*info = -1;
@ -27,8 +27,8 @@ void RELAPACK_slauum(
else if (*ldA < MAX(1, *n))
*info = -4;
if (*info) {
const int minfo = -*info;
LAPACK(xerbla)("SLAUUM", &minfo);
const blasint minfo = -*info;
LAPACK(xerbla)("SLAUUM", &minfo, strlen("SLAUUM"));
return;
}
@ -42,9 +42,9 @@ void RELAPACK_slauum(
/** slauum's recursive compute kernel */
static void RELAPACK_slauum_rec(
const char *uplo, const int *n,
float *A, const int *ldA,
int *info
const char *uplo, const blasint *n,
float *A, const blasint *ldA,
blasint *info
) {
if (*n <= MAX(CROSSOVER_SLAUUM, 1)) {
@ -57,8 +57,8 @@ static void RELAPACK_slauum_rec(
const float ONE[] = { 1. };
// Splitting
const int n1 = SREC_SPLIT(*n);
const int n2 = *n - n1;
const blasint n1 = SREC_SPLIT(*n);
const blasint n2 = *n - n1;
// A_TL A_TR
// A_BL A_BR

42
relapack/src/spbtrf.c
View File

@ -1,8 +1,8 @@
#include "relapack.h"
#include "stdlib.h"
static void RELAPACK_spbtrf_rec(const char *, const int *, const int *,
float *, const int *, float *, const int *, int *);
static void RELAPACK_spbtrf_rec(const char *, const blasint *, const blasint *,
float *, const blasint *, float *, const blasint *, blasint *);
/** 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
* */
void RELAPACK_spbtrf(
const char *uplo, const int *n, const int *kd,
float *Ab, const int *ldAb,
int *info
const char *uplo, const blasint *n, const blasint *kd,
float *Ab, const blasint *ldAb,
blasint *info
) {
// Check arguments
const int lower = LAPACK(lsame)(uplo, "L");
const int upper = LAPACK(lsame)(uplo, "U");
const blasint lower = LAPACK(lsame)(uplo, "L");
const blasint upper = LAPACK(lsame)(uplo, "U");
*info = 0;
if (!lower && !upper)
*info = -1;
@ -30,8 +30,8 @@ void RELAPACK_spbtrf(
else if (*ldAb < *kd + 1)
*info = -5;
if (*info) {
const int minfo = -*info;
LAPACK(xerbla)("SPBTRF", &minfo);
const blasint minfo = -*info;
LAPACK(xerbla)("SPBTRF", &minfo, strlen("SPBTRF"));
return;
}
@ -42,9 +42,9 @@ void RELAPACK_spbtrf(
const float ZERO[] = { 0. };
// Allocate work space
const int n1 = SREC_SPLIT(*n);
const int mWork = (*kd > n1) ? (lower ? *n - *kd : n1) : *kd;
const int nWork = (*kd > n1) ? (lower ? n1 : *n - *kd) : *kd;
const blasint n1 = SREC_SPLIT(*n);
const blasint mWork = (*kd > n1) ? (lower ? *n - *kd : n1) : *kd;
const blasint nWork = (*kd > n1) ? (lower ? n1 : *n - *kd) : *kd;
float *Work = malloc(mWork * nWork * sizeof(float));
LAPACK(slaset)(uplo, &mWork, &nWork, ZERO, ZERO, Work, &mWork);
@ -58,10 +58,10 @@ void RELAPACK_spbtrf(
/** spbtrf's recursive compute kernel */
static void RELAPACK_spbtrf_rec(
const char *uplo, const int *n, const int *kd,
float *Ab, const int *ldAb,
float *Work, const int *ldWork,
int *info
const char *uplo, const blasint *n, const blasint *kd,
float *Ab, const blasint *ldAb,
float *Work, const blasint *ldWork,
blasint *info
){
if (*n <= MAX(CROSSOVER_SPBTRF, 1)) {
@ -75,12 +75,12 @@ static void RELAPACK_spbtrf_rec(
const float MONE[] = { -1. };
// Unskew A
const int ldA[] = { *ldAb - 1 };
const blasint ldA[] = { *ldAb - 1 };
float *const A = Ab + ((*uplo == 'L') ? 0 : *kd);
// Splitting
const int n1 = MIN(SREC_SPLIT(*n), *kd);
const int n2 = *n - n1;
const blasint n1 = MIN(SREC_SPLIT(*n), *kd);
const blasint n2 = *n - n1;
// * *
// * Ab_BR
@ -99,8 +99,8 @@ static void RELAPACK_spbtrf_rec(
return;
// Banded splitting
const int n21 = MIN(n2, *kd - n1);
const int n22 = MIN(n2 - n21, *kd);
const blasint n21 = MIN(n2, *kd - n1);
const blasint n22 = MIN(n2 - n21, *kd);
// n1 n21 n22
// n1 * A_TRl A_TRr

28
relapack/src/spotrf.c
View File

@ -1,7 +1,7 @@
#include "relapack.h"
static void RELAPACK_spotrf_rec(const char *, const int *, float *,
const int *, int *);
static void RELAPACK_spotrf_rec(const char *, const blasint *, float *,
const blasint *, blasint *);
/** 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
* */
void RELAPACK_spotrf(
const char *uplo, const int *n,
float *A, const int *ldA,
int *info
const char *uplo, const blasint *n,
float *A, const blasint *ldA,
blasint *info
) {
// Check arguments
const int lower = LAPACK(lsame)(uplo, "L");
const int upper = LAPACK(lsame)(uplo, "U");
const blasint lower = LAPACK(lsame)(uplo, "L");
const blasint upper = LAPACK(lsame)(uplo, "U");
*info = 0;
if (!lower && !upper)
*info = -1;
@ -27,8 +27,8 @@ void RELAPACK_spotrf(
else if (*ldA < MAX(1, *n))
*info = -4;
if (*info) {
const int minfo = -*info;
LAPACK(xerbla)("SPOTRF", &minfo);
const blasint minfo = -*info;
LAPACK(xerbla)("SPOTRF", &minfo, strlen("SPOTRF"));
return;
}
@ -42,9 +42,9 @@ void RELAPACK_spotrf(
/** spotrf's recursive compute kernel */
static void RELAPACK_spotrf_rec(
const char *uplo, const int *n,
float *A, const int *ldA,
int *info
const char *uplo, const blasint *n,
float *A, const blasint *ldA,
blasint *info
) {
if (*n <= MAX(CROSSOVER_SPOTRF, 1)) {
@ -58,8 +58,8 @@ static void RELAPACK_spotrf_rec(
const float MONE[] = { -1. };
// Splitting
const int n1 = SREC_SPLIT(*n);
const int n2 = *n - n1;
const blasint n1 = SREC_SPLIT(*n);
const blasint n2 = *n - n1;
// A_TL A_TR
// A_BL A_BR

38
relapack/src/ssygst.c
View File

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

73
relapack/src/ssytrf.c
View File

@ -2,9 +2,8 @@
#if XSYTRF_ALLOW_MALLOC
#include <stdlib.h>
#endif
static void RELAPACK_ssytrf_rec(const char *, const int *, const int *, int *,
float *, const int *, int *, float *, const int *, int *);
static void RELAPACK_ssytrf_rec(const char *, const blasint *, const blasint *, blasint *,
float *, const blasint *, blasint *, float *, const blasint *, blasint *);
/** 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
* */
void RELAPACK_ssytrf(
const char *uplo, const int *n,
float *A, const int *ldA, int *ipiv,
float *Work, const int *lWork, int *info
const char *uplo, const blasint *n,
float *A, const blasint *ldA, blasint *ipiv,
float *Work, const blasint *lWork, blasint *info
) {
// Required work size
const int cleanlWork = *n * (*n / 2);
int minlWork = cleanlWork;
const blasint cleanlWork = *n * (*n / 2);
blasint minlWork = cleanlWork;
#if XSYTRF_ALLOW_MALLOC
minlWork = 1;
#endif
// Check arguments
const int lower = LAPACK(lsame)(uplo, "L");
const int upper = LAPACK(lsame)(uplo, "U");
const blasint lower = LAPACK(lsame)(uplo, "L");
const blasint upper = LAPACK(lsame)(uplo, "U");
*info = 0;
if (!lower && !upper)
*info = -1;
@ -55,8 +54,8 @@ void RELAPACK_ssytrf(
#endif
if (*info) {
const int minfo = -*info;
LAPACK(xerbla)("SSYTRF", &minfo);
const blasint minfo = -*info;
LAPACK(xerbla)("SSYTRF", &minfo, strlen("SSYTRF"));
return;
}
@ -64,7 +63,7 @@ void RELAPACK_ssytrf(
const char cleanuplo = lower ? 'L' : 'U';
// Dummy arguments
int nout;
blasint nout;
// Recursive kernel
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 */
static void RELAPACK_ssytrf_rec(
const char *uplo, const int *n_full, const int *n, int *n_out,
float *A, const int *ldA, int *ipiv,
float *Work, const int *ldWork, int *info
const char *uplo, const blasint *n_full, const blasint *n, blasint *n_out,
float *A, const blasint *ldA, blasint *ipiv,
float *Work, const blasint *ldWork, blasint *info
) {
// top recursion level?
const int top = *n_full == *n;
const blasint top = *n_full == *n;
if (*n <= MAX(CROSSOVER_SSYTRF, 3)) {
// Unblocked
@ -96,34 +95,34 @@ static void RELAPACK_ssytrf_rec(
return;
}
int info1, info2;
blasint info1, info2;
// Constants
const float ONE[] = { 1. };
const float MONE[] = { -1. };
const int iONE[] = { 1 };
const blasint iONE[] = { 1 };
// Loop iterator
int i;
blasint i;
const int n_rest = *n_full - *n;
const blasint n_rest = *n_full - *n;
if (*uplo == 'L') {
// Splitting (setup)
int n1 = SREC_SPLIT(*n);
int n2 = *n - n1;
blasint n1 = SREC_SPLIT(*n);
blasint n2 = *n - n1;
// Work_L *
float *const Work_L = Work;
// 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);
n1 = n1_out;
// Splitting (continued)
n2 = *n - n1;
const int n_full2 = *n_full - n1;
const blasint n_full2 = *n_full - n1;
// * *
// A_BL A_BR
@ -139,23 +138,23 @@ static void RELAPACK_ssytrf_rec(
// (top recursion level: use Work as Work_BR)
float *const Work_BL = Work + 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_B
int *const ipiv_B = ipiv + n1;
blasint *const ipiv_B = ipiv + n1;
// 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);
BLAS(sgemm)("N", "T", &n_rest, &n2, &n1, MONE, A_BL_B, ldA, Work_BL, ldWork, ONE, A_BR_B, ldA);
// 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);
if (n2_out != n2) {
// undo 1 column of updates
const int n_restp1 = n_rest + 1;
const blasint n_restp1 = n_rest + 1;
// last column of A_BR
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;
} else {
// Splitting (setup)
int n2 = SREC_SPLIT(*n);
int n1 = *n - n2;
blasint n2 = SREC_SPLIT(*n);
blasint n1 = *n - n2;
// * Work_R
// (top recursion level: use Work as Work_R)
float *const Work_R = top ? Work : Work + *ldWork * n1;
// 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);
const int n2_diff = n2 - n2_out;
const blasint n2_diff = n2 - n2_out;
n2 = n2_out;
// Splitting (continued)
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 A_TR
@ -213,19 +212,19 @@ static void RELAPACK_ssytrf_rec(
// (top recursion level: Work_R was Work)
float *const Work_L = Work;
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'
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);
// 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);
if (n1_out != n1) {
// 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'
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 */
static int c__1 = 1;
static blasint c__1 = 1;
static float c_b8 = -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
* recursive algorithm.
* */
/* Subroutine */ void RELAPACK_ssytrf_rec2(char *uplo, int *n, int *
nb, int *kb, float *a, int *lda, int *ipiv, float *w,
int *ldw, int *info, ftnlen uplo_len)
/* Subroutine */ void RELAPACK_ssytrf_rec2(char *uplo, blasint *n, blasint *
nb, blasint *kb, float *a, blasint *lda, blasint *ipiv, float *w,
int *ldw, blasint *info, ftnlen uplo_len)
{
/* 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;
/* Builtin functions */
double sqrt(double);
/* Local variables */
static int j, k;
static blasint j, k;
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;
extern logical lsame_(char *, char *, ftnlen, ftnlen);
extern /* Subroutine */ int sscal_(int *, float *, float *, int *),
sgemv_(char *, int *, int *, float *, float *, int *,
float *, int *, float *, float *, int *, ftnlen);
static int kstep;
extern /* Subroutine */ int scopy_(int *, float *, int *, float *,
int *), sswap_(int *, float *, int *, float *, int *
extern /* Subroutine */ blasint sscal_(int *, float *, float *, blasint *),
sgemv_(char *, blasint *, blasint *, float *, float *, blasint *,
float *, blasint *, float *, float *, blasint *, ftnlen);
static blasint kstep;
extern /* Subroutine */ blasint scopy_(int *, float *, blasint *, float *,
blasint *), sswap_(int *, float *, blasint *, float *, blasint *
);
static float absakk;
extern int isamax_(int *, float *, int *);
extern blasint isamax_(int *, float *, blasint *);
static float colmax, rowmax;
/* Parameter adjustments */

72
relapack/src/ssytrf_rook.c
View File

@ -3,8 +3,8 @@
#include <stdlib.h>
#endif
static void RELAPACK_ssytrf_rook_rec(const char *, const int *, const int *, int *,
float *, const int *, int *, float *, const int *, int *);
static void RELAPACK_ssytrf_rook_rec(const char *, const blasint *, const blasint *, blasint *,
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.
@ -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
* */
void RELAPACK_ssytrf_rook(
const char *uplo, const int *n,
float *A, const int *ldA, int *ipiv,
float *Work, const int *lWork, int *info
const char *uplo, const blasint *n,
float *A, const blasint *ldA, blasint *ipiv,
float *Work, const blasint *lWork, blasint *info
) {
// Required work size
const int cleanlWork = *n * (*n / 2);
int minlWork = cleanlWork;
const blasint cleanlWork = *n * (*n / 2);
blasint minlWork = cleanlWork;
#if XSYTRF_ALLOW_MALLOC
minlWork = 1;
#endif
// Check arguments
const int lower = LAPACK(lsame)(uplo, "L");
const int upper = LAPACK(lsame)(uplo, "U");
const blasint lower = LAPACK(lsame)(uplo, "L");
const blasint upper = LAPACK(lsame)(uplo, "U");
*info = 0;
if (!lower && !upper)
*info = -1;
@ -55,8 +55,8 @@ void RELAPACK_ssytrf_rook(
#endif
if (*info) {
const int minfo = -*info;
LAPACK(xerbla)("SSYTRF", &minfo);
const blasint minfo = -*info;
LAPACK(xerbla)("SSYTRF", &minfo, strlen("SSYTRF"));
return;
}
@ -64,7 +64,7 @@ void RELAPACK_ssytrf_rook(
const char cleanuplo = lower ? 'L' : 'U';
// Dummy argument
int nout;
blasint nout;
// Recursive kernel
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 */
static void RELAPACK_ssytrf_rook_rec(
const char *uplo, const int *n_full, const int *n, int *n_out,
float *A, const int *ldA, int *ipiv,
float *Work, const int *ldWork, int *info
const char *uplo, const blasint *n_full, const blasint *n, blasint *n_out,
float *A, const blasint *ldA, blasint *ipiv,
float *Work, const blasint *ldWork, blasint *info
) {
// top recursion level?
const int top = *n_full == *n;
const blasint top = *n_full == *n;
if (*n <= MAX(CROSSOVER_SSYTRF_ROOK, 3)) {
// Unblocked
@ -96,31 +96,31 @@ static void RELAPACK_ssytrf_rook_rec(
return;
}
int info1, info2;
blasint info1, info2;
// Constants
const float ONE[] = { 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') {
// Splitting (setup)
int n1 = SREC_SPLIT(*n);
int n2 = *n - n1;
blasint n1 = SREC_SPLIT(*n);
blasint n2 = *n - n1;
// Work_L *
float *const Work_L = Work;
// 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);
n1 = n1_out;
// Splitting (continued)
n2 = *n - n1;
const int n_full2 = *n_full - n1;
const blasint n_full2 = *n_full - n1;
// * *
// A_BL A_BR
@ -136,23 +136,23 @@ static void RELAPACK_ssytrf_rook_rec(
// (top recursion level: use Work as Work_BR)
float *const Work_BL = Work + 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_B
int *const ipiv_B = ipiv + n1;
blasint *const ipiv_B = ipiv + n1;
// 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);
BLAS(sgemm)("N", "T", &n_rest, &n2, &n1, MONE, A_BL_B, ldA, Work_BL, ldWork, ONE, A_BR_B, ldA);
// 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);
if (n2_out != n2) {
// undo 1 column of updates
const int n_restp1 = n_rest + 1;
const blasint n_restp1 = n_rest + 1;
// last column of A_BR
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;
// shift pivots
int i;
blasint i;
for (i = 0; i < n2; i++)
if (ipiv_B[i] > 0)
ipiv_B[i] += n1;
@ -180,22 +180,22 @@ static void RELAPACK_ssytrf_rook_rec(
*n_out = n1 + n2;
} else {
// Splitting (setup)
int n2 = SREC_SPLIT(*n);
int n1 = *n - n2;
blasint n2 = SREC_SPLIT(*n);
blasint n1 = *n - n2;
// * Work_R
// (top recursion level: use Work as Work_R)
float *const Work_R = top ? Work : Work + *ldWork * n1;
// 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);
const int n2_diff = n2 - n2_out;
const blasint n2_diff = n2 - n2_out;
n2 = n2_out;
// Splitting (continued)
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 A_TR
@ -211,19 +211,19 @@ static void RELAPACK_ssytrf_rook_rec(
// (top recursion level: Work_R was Work)
float *const Work_L = Work;
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'
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);
// 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);
if (n1_out != n1) {
// 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'
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 */
static int c__1 = 1;
static blasint c__1 = 1;
static float c_b9 = -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
* recursive algorithm.
* */
/* Subroutine */ void RELAPACK_ssytrf_rook_rec2(char *uplo, int *n,
int *nb, int *kb, float *a, int *lda, int *ipiv, float *
w, int *ldw, int *info, ftnlen uplo_len)
/* Subroutine */ void RELAPACK_ssytrf_rook_rec2(char *uplo, blasint *n,
int *nb, blasint *kb, float *a, blasint *lda, blasint *ipiv, float *
w, blasint *ldw, blasint *info, ftnlen uplo_len)
{
/* 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;
/* Builtin functions */
double sqrt(double);
/* Local variables */
static int j, k, p;
static blasint j, k, p;
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 int imax, jmax;
static blasint imax, jmax;
static float alpha;
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 int itemp;
extern /* Subroutine */ int sgemv_(char *, int *, int *, float *,
float *, int *, float *, int *, float *, float *, int *,
static blasint itemp;
extern /* Subroutine */ blasint sgemv_(char *, blasint *, blasint *, float *,
float *, blasint *, float *, blasint *, float *, float *, blasint *,
ftnlen);
static int kstep;
static blasint kstep;
static float stemp;
extern /* Subroutine */ int scopy_(int *, float *, int *, float *,
int *), sswap_(int *, float *, int *, float *, int *
extern /* Subroutine */ blasint scopy_(int *, float *, blasint *, float *,
blasint *), sswap_(int *, float *, blasint *, float *, blasint *
);
static float absakk;
extern double slamch_(char *, ftnlen);
extern int isamax_(int *, float *, int *);
extern blasint isamax_(int *, float *, blasint *);
static float colmax, rowmax;
/* Parameter adjustments */

66
relapack/src/stgsyl.c
View File

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

56
relapack/src/strsyl.c
View File

@ -1,8 +1,8 @@
#include "relapack.h"
static void RELAPACK_strsyl_rec(const char *, const char *, const int *,
const int *, const int *, const float *, const int *, const float *,
const int *, float *, const int *, float *, int *);
static void RELAPACK_strsyl_rec(const char *, const char *, const blasint *,
const blasint *, const blasint *, const float *, const blasint *, const float *,
const blasint *, float *, const blasint *, float *, blasint *);
/** 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
* */
void RELAPACK_strsyl(
const char *tranA, const char *tranB, const int *isgn,
const int *m, const int *n,
const float *A, const int *ldA, const float *B, const int *ldB,
float *C, const int *ldC, float *scale,
int *info
const char *tranA, const char *tranB, const blasint *isgn,
const blasint *m, const blasint *n,
const float *A, const blasint *ldA, const float *B, const blasint *ldB,
float *C, const blasint *ldC, float *scale,
blasint *info
) {
// Check arguments
const int notransA = LAPACK(lsame)(tranA, "N");
const int transA = LAPACK(lsame)(tranA, "T");
const int ctransA = LAPACK(lsame)(tranA, "C");
const int notransB = LAPACK(lsame)(tranB, "N");
const int transB = LAPACK(lsame)(tranB, "T");
const int ctransB = LAPACK(lsame)(tranB, "C");
const blasint notransA = LAPACK(lsame)(tranA, "N");
const blasint transA = LAPACK(lsame)(tranA, "T");
const blasint ctransA = LAPACK(lsame)(tranA, "C");
const blasint notransB = LAPACK(lsame)(tranB, "N");
const blasint transB = LAPACK(lsame)(tranB, "T");
const blasint ctransB = LAPACK(lsame)(tranB, "C");
*info = 0;
if (!transA && !ctransA && !notransA)
*info = -1;
@ -44,8 +44,8 @@ void RELAPACK_strsyl(
else if (*ldC < MAX(1, *m))
*info = -11;
if (*info) {
const int minfo = -*info;
LAPACK(xerbla)("STRSYL", &minfo);
const blasint minfo = -*info;
LAPACK(xerbla)("STRSYL", &minfo, strlen("STRSYL"));
return;
}
@ -60,11 +60,11 @@ void RELAPACK_strsyl(
/** strsyl's recursive compute kernel */
static void RELAPACK_strsyl_rec(
const char *tranA, const char *tranB, const int *isgn,
const int *m, const int *n,
const float *A, const int *ldA, const float *B, const int *ldB,
float *C, const int *ldC, float *scale,
int *info
const char *tranA, const char *tranB, const blasint *isgn,
const blasint *m, const blasint *n,
const float *A, const blasint *ldA, const float *B, const blasint *ldB,
float *C, const blasint *ldC, float *scale,
blasint *info
) {
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 MONE[] = { -1. };
const float MSGN[] = { -*isgn };
const int iONE[] = { 1 };
const blasint iONE[] = { 1 };
// Outputs
float scale1[] = { 1. };
float scale2[] = { 1. };
int info1[] = { 0 };
int info2[] = { 0 };
blasint info1[] = { 0 };
blasint info2[] = { 0 };
if (*m > *n) {
// Splitting
int m1 = SREC_SPLIT(*m);
blasint m1 = SREC_SPLIT(*m);
if (A[m1 + *ldA * (m1 - 1)])
m1++;
const int m2 = *m - m1;
const blasint m2 = *m - m1;
// A_TL A_TR
// 0 A_BR
@ -126,10 +126,10 @@ static void RELAPACK_strsyl_rec(
}
} else {
// Splitting
int n1 = SREC_SPLIT(*n);
blasint n1 = SREC_SPLIT(*n);
if (B[n1 + *ldB * (n1 - 1)])
n1++;
const int n2 = *n - n1;
const blasint n2 = *n - n1;
// B_TL B_TR
// 0 B_BR

50
relapack/src/strsyl_rec2.c
View File

@ -14,48 +14,48 @@
/* Table of constant values */
static int c__1 = 1;
static int c_false = FALSE_;
static int c__2 = 2;
static blasint c__1 = 1;
static blasint c_false = FALSE_;
static blasint c__2 = 2;
static float c_b26 = 1.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
*m, int *n, float *a, int *lda, float *b, int *ldb, float *
c__, int *ldc, float *scale, int *info, ftnlen trana_len,
void RELAPACK_strsyl_rec2(char *trana, char *tranb, blasint *isgn, int
*m, blasint *n, float *a, blasint *lda, float *b, blasint *ldb, float *
c__, blasint *ldc, float *scale, blasint *info, ftnlen trana_len,
ftnlen tranb_len)
{
/* 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;
float r__1, r__2;
/* Local variables */
static int j, k, l;
static blasint j, k, l;
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 int ierr;
static blasint ierr;
static float smin;
extern float sdot_(int *, float *, int *, float *, int *);
extern float sdot_(int *, float *, blasint *, float *, blasint *);
static float suml, sumr;
extern int lsame_(char *, char *, ftnlen, ftnlen);
extern /* Subroutine */ int sscal_(int *, float *, float *, int *);
static int knext, lnext;
extern blasint lsame_(char *, char *, ftnlen, ftnlen);
extern /* Subroutine */ blasint sscal_(int *, float *, float *, blasint *);
static blasint knext, lnext;
static float xnorm;
extern /* Subroutine */ int slaln2_(int *, int *, int *, float
*, float *, float *, int *, float *, float *, float *, int *,
float *, float *, float *, int *, float *, float *, int *),
slasy2_(int *, int *, int *, int *, int *,
float *, int *, float *, int *, float *, int *, float *,
float *, int *, float *, int *), slabad_(float *, float *);
extern /* Subroutine */ blasint slaln2_(int *, blasint *, blasint *, float
*, float *, float *, blasint *, float *, float *, float *, blasint *,
float *, float *, float *, blasint *, float *, float *, blasint *),
slasy2_(int *, blasint *, blasint *, blasint *, blasint *,
float *, blasint *, float *, blasint *, float *, blasint *, float *,
float *, blasint *, float *, blasint *), slabad_(float *, float *);
static float scaloc;
extern float slamch_(char *, ftnlen), slange_(char *, int *,
int *, float *, int *, float *, ftnlen);
extern /* Subroutine */ int xerbla_(char *, int *, ftnlen);
extern float slamch_(char *, ftnlen), slange_(char *, blasint *,
blasint *, float *, blasint *, float *, ftnlen);
extern /* Subroutine */ blasint xerbla_(char *, blasint *, ftnlen);
static float bignum;
static int notrna, notrnb;
static blasint notrna, notrnb;
static float smlnum;
/* Parameter adjustments */

34
relapack/src/strtri.c
View File

@ -1,7 +1,7 @@
#include "relapack.h"
static void RELAPACK_strtri_rec(const char *, const char *, const int *,
float *, const int *, int *);
static void RELAPACK_strtri_rec(const char *, const char *, const blasint *,
float *, const blasint *, blasint *);
/** 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
* */
void RELAPACK_strtri(
const char *uplo, const char *diag, const int *n,
float *A, const int *ldA,
int *info
const char *uplo, const char *diag, const blasint *n,
float *A, const blasint *ldA,
blasint *info
) {
// Check arguments
const int lower = LAPACK(lsame)(uplo, "L");
const int upper = LAPACK(lsame)(uplo, "U");
const int nounit = LAPACK(lsame)(diag, "N");
const int unit = LAPACK(lsame)(diag, "U");
const blasint lower = LAPACK(lsame)(uplo, "L");
const blasint upper = LAPACK(lsame)(uplo, "U");
const blasint nounit = LAPACK(lsame)(diag, "N");
const blasint unit = LAPACK(lsame)(diag, "U");
*info = 0;
if (!lower && !upper)
*info = -1;
@ -31,8 +31,8 @@ void RELAPACK_strtri(
else if (*ldA < MAX(1, *n))
*info = -5;
if (*info) {
const int minfo = -*info;
LAPACK(xerbla)("STRTRI", &minfo);
const blasint minfo = -*info;
LAPACK(xerbla)("STRTRI", &minfo, strlen("STRTRI"));
return;
}
@ -42,7 +42,7 @@ void RELAPACK_strtri(
// check for singularity
if (nounit) {
int i;
blasint i;
for (i = 0; i < *n; i++)
if (A[i + *ldA * i] == 0) {
*info = i;
@ -57,9 +57,9 @@ void RELAPACK_strtri(
/** strtri's recursive compute kernel */
static void RELAPACK_strtri_rec(
const char *uplo, const char *diag, const int *n,
float *A, const int *ldA,
int *info
const char *uplo, const char *diag, const blasint *n,
float *A, const blasint *ldA,
blasint *info
){
if (*n <= MAX(CROSSOVER_STRTRI, 1)) {
@ -73,8 +73,8 @@ static void RELAPACK_strtri_rec(
const float MONE[] = { -1. };
// Splitting
const int n1 = SREC_SPLIT(*n);
const int n2 = *n - n1;
const blasint n1 = SREC_SPLIT(*n);
const blasint n2 = *n - n1;
// A_TL A_TR
// A_BL A_BR

78
relapack/src/zgbtrf.c
View File

@ -1,9 +1,9 @@
#include "relapack.h"
#include "stdlib.h"
static void RELAPACK_zgbtrf_rec(const int *, const int *, const int *,
const int *, double *, const int *, int *, double *, const int *, double *,
const int *, int *);
static void RELAPACK_zgbtrf_rec(const blasint *, const blasint *, const blasint *,
const blasint *, double *, const blasint *, blasint *, double *, const blasint *, double *,
const blasint *, blasint *);
/** 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
* */
void RELAPACK_zgbtrf(
const int *m, const int *n, const int *kl, const int *ku,
double *Ab, const int *ldAb, int *ipiv,
int *info
const blasint *m, const blasint *n, const blasint *kl, const blasint *ku,
double *Ab, const blasint *ldAb, blasint *ipiv,
blasint *info
) {
// Check arguments
@ -31,8 +31,8 @@ void RELAPACK_zgbtrf(
else if (*ldAb < 2 * *kl + *ku + 1)
*info = -6;
if (*info) {
const int minfo = -*info;
LAPACK(xerbla)("ZGBTRF", &minfo);
const blasint minfo = -*info;
LAPACK(xerbla)("ZGBTRF", &minfo, strlen("ZGBTRF"));
return;
}
@ -40,14 +40,14 @@ void RELAPACK_zgbtrf(
const double ZERO[] = { 0., 0. };
// Result upper band width
const int kv = *ku + *kl;
const blasint kv = *ku + *kl;
// Unskew A
const int ldA[] = { *ldAb - 1 };
const blasint ldA[] = { *ldAb - 1 };
double *const A = Ab + 2 * kv;
// Zero upper diagonal fill-in elements
int i, j;
blasint i, j;
for (j = 0; j < *n; j++) {
double *const A_j = A + 2 * *ldA * j;
for (i = MAX(0, j - kv); i < j - *ku; i++)
@ -55,11 +55,11 @@ void RELAPACK_zgbtrf(
}
// Allocate work space
const int n1 = ZREC_SPLIT(*n);
const int mWorkl = (kv > n1) ? MAX(1, *m - *kl) : kv;
const int nWorkl = (kv > n1) ? n1 : kv;
const int mWorku = (*kl > n1) ? n1 : *kl;
const int nWorku = (*kl > n1) ? MAX(0, *n - *kl) : *kl;
const blasint n1 = ZREC_SPLIT(*n);
const blasint mWorkl = (kv > n1) ? MAX(1, *m - *kl) : kv;
const blasint nWorkl = (kv > n1) ? n1 : kv;
const blasint mWorku = (*kl > n1) ? n1 : *kl;
const blasint nWorku = (*kl > n1) ? MAX(0, *n - *kl) : *kl;
double *Workl = malloc(mWorkl * nWorkl * 2 * sizeof(double));
double *Worku = malloc(mWorku * nWorku * 2 * sizeof(double));
LAPACK(zlaset)("L", &mWorkl, &nWorkl, ZERO, ZERO, Workl, &mWorkl);
@ -76,10 +76,10 @@ void RELAPACK_zgbtrf(
/** zgbtrf's recursive compute kernel */
static void RELAPACK_zgbtrf_rec(
const int *m, const int *n, const int *kl, const int *ku,
double *Ab, const int *ldAb, int *ipiv,
double *Workl, const int *ldWorkl, double *Worku, const int *ldWorku,
int *info
const blasint *m, const blasint *n, const blasint *kl, const blasint *ku,
double *Ab, const blasint *ldAb, blasint *ipiv,
double *Workl, const blasint *ldWorkl, double *Worku, const blasint *ldWorku,
blasint *info
) {
if (*n <= MAX(CROSSOVER_ZGBTRF, 1)) {
@ -91,25 +91,25 @@ static void RELAPACK_zgbtrf_rec(
// Constants
const double ONE[] = { 1., 0. };
const double MONE[] = { -1., 0. };
const int iONE[] = { 1 };
const blasint iONE[] = { 1 };
// Loop iterators
int i, j;
blasint i, j;
// Output upper band width
const int kv = *ku + *kl;
const blasint kv = *ku + *kl;
// Unskew A
const int ldA[] = { *ldAb - 1 };
const blasint ldA[] = { *ldAb - 1 };
double *const A = Ab + 2 * kv;
// Splitting
const int n1 = MIN(ZREC_SPLIT(*n), *kl);
const int n2 = *n - n1;
const int m1 = MIN(n1, *m);
const int m2 = *m - m1;
const int mn1 = MIN(m1, n1);
const int mn2 = MIN(m2, n2);
const blasint n1 = MIN(ZREC_SPLIT(*n), *kl);
const blasint n2 = *n - n1;
const blasint m1 = MIN(n1, *m);
const blasint m2 = *m - m1;
const blasint mn1 = MIN(m1, n1);
const blasint mn2 = MIN(m2, n2);
// Ab_L *
// Ab_BR
@ -129,14 +129,14 @@ static void RELAPACK_zgbtrf_rec(
// ipiv_T
// ipiv_B
int *const ipiv_T = ipiv;
int *const ipiv_B = ipiv + n1;
blasint *const ipiv_T = ipiv;
blasint *const ipiv_B = ipiv + n1;
// Banded splitting
const int n21 = MIN(n2, kv - n1);
const int n22 = MIN(n2 - n21, n1);
const int m21 = MIN(m2, *kl - m1);
const int m22 = MIN(m2 - m21, m1);
const blasint n21 = MIN(n2, kv - n1);
const blasint n22 = MIN(n2 - n21, n1);
const blasint m21 = MIN(m2, *kl - m1);
const blasint m22 = MIN(m2 - m21, m1);
// n1 n21 n22
// m * A_Rl ARr
@ -164,7 +164,7 @@ static void RELAPACK_zgbtrf_rec(
// partially redo swaps in A_L
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 < *kl)
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++) {
double *const A_Rrj = A_Rr + 2 * *ldA * j;
for (i = j; i < mn1; i++) {
const int ip = ipiv_T[i] - 1;
const blasint ip = ipiv_T[i] - 1;
if (ip != i) {
const double tmpr = A_Rrj[2 * i];
const double tmpc = A_Rrj[2 * i + 1];
@ -211,7 +211,7 @@ static void RELAPACK_zgbtrf_rec(
// partially undo swaps in A_L
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 < *kl)
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"
static void RELAPACK_zgemmt_rec(const char *, const char *, const char *,
const int *, const int *, const double *, const double *, const int *,
const double *, const int *, const double *, double *, const int *);
const blasint *, const blasint *, const double *, const double *, const blasint *,
const double *, const blasint *, const double *, double *, const blasint *);
static void RELAPACK_zgemmt_rec2(const char *, const char *, const char *,
const int *, const int *, const double *, const double *, const int *,
const double *, const int *, const double *, double *, const int *);
const blasint *, const blasint *, const double *, const double *, const blasint *,
const double *, const blasint *, const double *, double *, const blasint *);
/** 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(
const char *uplo, const char *transA, const char *transB,
const int *n, const int *k,
const double *alpha, const double *A, const int *ldA,
const double *B, const int *ldB,
const double *beta, double *C, const int *ldC
const blasint *n, const blasint *k,
const double *alpha, const double *A, const blasint *ldA,
const double *B, const blasint *ldB,
const double *beta, double *C, const blasint *ldC
) {
#if HAVE_XGEMMT
@ -32,15 +32,15 @@ void RELAPACK_zgemmt(
#else
// Check arguments
const int lower = LAPACK(lsame)(uplo, "L");
const int upper = LAPACK(lsame)(uplo, "U");
const int notransA = LAPACK(lsame)(transA, "N");
const int tranA = LAPACK(lsame)(transA, "T");
const int ctransA = LAPACK(lsame)(transA, "C");
const int notransB = LAPACK(lsame)(transB, "N");
const int tranB = LAPACK(lsame)(transB, "T");
const int ctransB = LAPACK(lsame)(transB, "C");
int info = 0;
const blasint lower = LAPACK(lsame)(uplo, "L");
const blasint upper = LAPACK(lsame)(uplo, "U");
const blasint notransA = LAPACK(lsame)(transA, "N");
const blasint tranA = LAPACK(lsame)(transA, "T");
const blasint ctransA = LAPACK(lsame)(transA, "C");
const blasint notransB = LAPACK(lsame)(transB, "N");
const blasint tranB = LAPACK(lsame)(transB, "T");
const blasint ctransB = LAPACK(lsame)(transB, "C");
blasint info = 0;
if (!lower && !upper)
info = 1;
else if (!tranA && !ctransA && !notransA)
@ -58,7 +58,7 @@ void RELAPACK_zgemmt(
else if (*ldC < MAX(1, *n))
info = 13;
if (info) {
LAPACK(xerbla)("ZGEMMT", &info);
LAPACK(xerbla)("ZGEMMT", &info, strlen("ZGEMMT"));
return;
}
@ -76,10 +76,10 @@ void RELAPACK_zgemmt(
/** zgemmt's recursive compute kernel */
static void RELAPACK_zgemmt_rec(
const char *uplo, const char *transA, const char *transB,
const int *n, const int *k,
const double *alpha, const double *A, const int *ldA,
const double *B, const int *ldB,
const double *beta, double *C, const int *ldC
const blasint *n, const blasint *k,
const double *alpha, const double *A, const blasint *ldA,
const double *B, const blasint *ldB,
const double *beta, double *C, const blasint *ldC
) {
if (*n <= MAX(CROSSOVER_ZGEMMT, 1)) {
@ -89,8 +89,8 @@ static void RELAPACK_zgemmt_rec(
}
// Splitting
const int n1 = ZREC_SPLIT(*n);
const int n2 = *n - n1;
const blasint n1 = ZREC_SPLIT(*n);
const blasint n2 = *n - n1;
// A_T
// A_B
@ -126,16 +126,16 @@ static void RELAPACK_zgemmt_rec(
/** zgemmt's unblocked compute kernel */
static void RELAPACK_zgemmt_rec2(
const char *uplo, const char *transA, const char *transB,
const int *n, const int *k,
const double *alpha, const double *A, const int *ldA,
const double *B, const int *ldB,
const double *beta, double *C, const int *ldC
const blasint *n, const blasint *k,
const double *alpha, const double *A, const blasint *ldA,
const double *B, const blasint *ldB,
const double *beta, double *C, const blasint *ldC
) {
const int incB = (*transB == 'N') ? 1 : *ldB;
const int incC = 1;
const blasint incB = (*transB == 'N') ? 1 : *ldB;
const blasint incC = 1;
int i;
blasint i;
for (i = 0; i < *n; i++) {
// A_0
// A_i
@ -151,13 +151,13 @@ static void RELAPACK_zgemmt_rec2(
double *const C_ii = C + 2 * *ldC * i + 2 * i;
if (*uplo == 'L') {
const int nmi = *n - i;
const blasint nmi = *n - i;
if (*transA == 'N')
BLAS(zgemv)(transA, &nmi, k, alpha, A_i, ldA, B_i, &incB, beta, C_ii, &incC);
else
BLAS(zgemv)(transA, k, &nmi, alpha, A_i, ldA, B_i, &incB, beta, C_ii, &incC);
} else {
const int ip1 = i + 1;
const blasint ip1 = i + 1;
if (*transA == 'N')
BLAS(zgemv)(transA, &ip1, k, alpha, A_0, ldA, B_i, &incB, beta, C_0i, &incC);
else

40
relapack/src/zgetrf.c
View File

@ -1,7 +1,7 @@
#include "relapack.h"
static void RELAPACK_zgetrf_rec(const int *, const int *, double *,
const int *, int *, int *);
static void RELAPACK_zgetrf_rec(const blasint *, const blasint *, double *,
const blasint *, blasint *, blasint *);
/** 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
* */
void RELAPACK_zgetrf(
const int *m, const int *n,
double *A, const int *ldA, int *ipiv,
int *info
const blasint *m, const blasint *n,
double *A, const blasint *ldA, blasint *ipiv,
blasint *info
) {
// Check arguments
@ -25,12 +25,12 @@ void RELAPACK_zgetrf(
else if (*ldA < MAX(1, *n))
*info = -4;
if (*info) {
const int minfo = -*info;
LAPACK(xerbla)("ZGETRF", &minfo);
const blasint minfo = -*info;
LAPACK(xerbla)("ZGETRF", &minfo, strlen("ZGETRF"));
return;
}
const int sn = MIN(*m, *n);
const blasint sn = MIN(*m, *n);
RELAPACK_zgetrf_rec(m, &sn, A, ldA, ipiv, info);
@ -38,10 +38,10 @@ void RELAPACK_zgetrf(
if (*m < *n) {
// Constants
const double ONE[] = { 1., 0. };
const int iONE[] = { 1 };
const blasint iONE[] = { 1 };
// Splitting
const int rn = *n - *m;
const blasint rn = *n - *m;
// A_L A_R
const double *const A_L = A;
@ -57,9 +57,9 @@ void RELAPACK_zgetrf(
/** zgetrf's recursive compute kernel */
static void RELAPACK_zgetrf_rec(
const int *m, const int *n,
double *A, const int *ldA, int *ipiv,
int *info
const blasint *m, const blasint *n,
double *A, const blasint *ldA, blasint *ipiv,
blasint *info
) {
if (*n <= MAX(CROSSOVER_ZGETRF, 1)) {
@ -71,12 +71,12 @@ static void RELAPACK_zgetrf_rec(
// Constants
const double ONE[] = { 1., 0. };
const double MONE[] = { -1., 0. };
const int iONE[] = { 1. };
const blasint iONE[] = { 1. };
// Splitting
const int n1 = ZREC_SPLIT(*n);
const int n2 = *n - n1;
const int m2 = *m - n1;
const blasint n1 = ZREC_SPLIT(*n);
const blasint n2 = *n - n1;
const blasint m2 = *m - n1;
// A_L A_R
double *const A_L = A;
@ -91,8 +91,8 @@ static void RELAPACK_zgetrf_rec(
// ipiv_T
// ipiv_B
int *const ipiv_T = ipiv;
int *const ipiv_B = ipiv + n1;
blasint *const ipiv_T = ipiv;
blasint *const ipiv_B = ipiv + n1;
// recursion(A_L, ipiv_T)
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
LAPACK(zlaswp)(&n1, A_BL, ldA, iONE, &n2, ipiv_B, iONE);
// shift pivots
int i;
blasint i;
for (i = 0; i < n2; i++)
ipiv_B[i] += n1;
}

38
relapack/src/zhegst.c
View File

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

72
relapack/src/zhetrf.c
View File

@ -3,8 +3,8 @@
#include <stdlib.h>
#endif
static void RELAPACK_zhetrf_rec(const char *, const int *, const int *, int *,
double *, const int *, int *, double *, const int *, int *);
static void RELAPACK_zhetrf_rec(const char *, const blasint *, const blasint *, blasint *,
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.
@ -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
* */
void RELAPACK_zhetrf(
const char *uplo, const int *n,
double *A, const int *ldA, int *ipiv,
double *Work, const int *lWork, int *info
const char *uplo, const blasint *n,
double *A, const blasint *ldA, blasint *ipiv,
double *Work, const blasint *lWork, blasint *info
) {
// Required work size
const int cleanlWork = *n * (*n / 2);
int minlWork = cleanlWork;
const blasint cleanlWork = *n * (*n / 2);
blasint minlWork = cleanlWork;
#if XSYTRF_ALLOW_MALLOC
minlWork = 1;
#endif
// Check arguments
const int lower = LAPACK(lsame)(uplo, "L");
const int upper = LAPACK(lsame)(uplo, "U");
const blasint lower = LAPACK(lsame)(uplo, "L");
const blasint upper = LAPACK(lsame)(uplo, "U");
*info = 0;
if (!lower && !upper)
*info = -1;
@ -55,8 +55,8 @@ void RELAPACK_zhetrf(
#endif
if (*info) {
const int minfo = -*info;
LAPACK(xerbla)("ZHETRF", &minfo);
const blasint minfo = -*info;
LAPACK(xerbla)("ZHETRF", &minfo, strlen("ZHETRF"));
return;
}
@ -64,7 +64,7 @@ void RELAPACK_zhetrf(
const char cleanuplo = lower ? 'L' : 'U';
// Dummy argument
int nout;
blasint nout;
// Recursive kernel
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 */
static void RELAPACK_zhetrf_rec(
const char *uplo, const int *n_full, const int *n, int *n_out,
double *A, const int *ldA, int *ipiv,
double *Work, const int *ldWork, int *info
const char *uplo, const blasint *n_full, const blasint *n, blasint *n_out,
double *A, const blasint *ldA, blasint *ipiv,
double *Work, const blasint *ldWork, blasint *info
) {
// top recursion level?
const int top = *n_full == *n;
const blasint top = *n_full == *n;
if (*n <= MAX(CROSSOVER_ZHETRF, 3)) {
// Unblocked
@ -96,31 +96,31 @@ static void RELAPACK_zhetrf_rec(
return;
}
int info1, info2;
blasint info1, info2;
// Constants
const double ONE[] = { 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') {
// Splitting (setup)
int n1 = ZREC_SPLIT(*n);
int n2 = *n - n1;
blasint n1 = ZREC_SPLIT(*n);
blasint n2 = *n - n1;
// Work_L *
double *const Work_L = Work;
// 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);
n1 = n1_out;
// Splitting (continued)
n2 = *n - n1;
const int n_full2 = *n_full - n1;
const blasint n_full2 = *n_full - n1;
// * *
// A_BL A_BR
@ -136,23 +136,23 @@ static void RELAPACK_zhetrf_rec(
// (top recursion level: use Work as Work_BR)
double *const Work_BL = Work + 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_B
int *const ipiv_B = ipiv + n1;
blasint *const ipiv_B = ipiv + n1;
// 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);
BLAS(zgemm)("N", "T", &n_rest, &n2, &n1, MONE, A_BL_B, ldA, Work_BL, ldWork, ONE, A_BR_B, ldA);
// 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);
if (n2_out != n2) {
// undo 1 column of updates
const int n_restp1 = n_rest + 1;
const blasint n_restp1 = n_rest + 1;
// last column of A_BR
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;
// shift pivots
int i;
blasint i;
for (i = 0; i < n2; i++)
if (ipiv_B[i] > 0)
ipiv_B[i] += n1;
@ -180,22 +180,22 @@ static void RELAPACK_zhetrf_rec(
*n_out = n1 + n2;
} else {
// Splitting (setup)
int n2 = ZREC_SPLIT(*n);
int n1 = *n - n2;
blasint n2 = ZREC_SPLIT(*n);
blasint n1 = *n - n2;
// * Work_R
// (top recursion level: use Work as Work_R)
double *const Work_R = top ? Work : Work + 2 * *ldWork * n1;
// 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);
const int n2_diff = n2 - n2_out;
const blasint n2_diff = n2 - n2_out;
n2 = n2_out;
// Splitting (continued)
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 A_TR
@ -211,19 +211,19 @@ static void RELAPACK_zhetrf_rec(
// (top recursion level: Work_R was Work)
double *const Work_L = Work;
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'
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);
// 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);
if (n1_out != n1) {
// 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'
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 */
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
*
@ -24,12 +24,12 @@ static int c__1 = 1;
* The blocked BLAS Level 3 updates were removed and moved to the
* recursive algorithm.
* */
/* Subroutine */ void RELAPACK_zhetrf_rec2(char *uplo, int *n, int *
nb, int *kb, doublecomplex *a, int *lda, int *ipiv,
doublecomplex *w, int *ldw, int *info, ftnlen uplo_len)
/* Subroutine */ void RELAPACK_zhetrf_rec2(char *uplo, blasint *n, blasint *
nb, blasint *kb, doublecomplex *a, blasint *lda, blasint *ipiv,
doublecomplex *w, blasint *ldw, blasint *info, ftnlen uplo_len)
{
/* 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;
doublecomplex z__1, z__2, z__3, z__4;
@ -39,26 +39,26 @@ static int c__1 = 1;
doublecomplex *, doublecomplex *);
/* Local variables */
static int j, k;
static blasint j, k;
static double t, r1;
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;
extern logical lsame_(char *, char *, ftnlen, ftnlen);
static int kstep;
extern /* Subroutine */ int zgemv_(char *, int *, int *,
doublecomplex *, doublecomplex *, int *, doublecomplex *,
int *, doublecomplex *, doublecomplex *, int *, ftnlen),
zcopy_(int *, doublecomplex *, int *, doublecomplex *,
int *), zswap_(int *, doublecomplex *, int *,
doublecomplex *, int *);
static blasint kstep;
extern /* Subroutine */ blasint zgemv_(char *, blasint *, blasint *,
doublecomplex *, doublecomplex *, blasint *, doublecomplex *,
blasint *, doublecomplex *, doublecomplex *, blasint *, ftnlen),
zcopy_(int *, doublecomplex *, blasint *, doublecomplex *,
blasint *), zswap_(int *, doublecomplex *, blasint *,
doublecomplex *, blasint *);
static double absakk;
extern /* Subroutine */ int zdscal_(int *, double *,
doublecomplex *, int *);
extern /* Subroutine */ blasint zdscal_(int *, double *,
doublecomplex *, blasint *);
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;
/* Parameter adjustments */

72
relapack/src/zhetrf_rook.c
View File

@ -3,8 +3,8 @@
#include <stdlib.h>
#endif
static void RELAPACK_zhetrf_rook_rec(const char *, const int *, const int *, int *,
double *, const int *, int *, double *, const int *, int *);
static void RELAPACK_zhetrf_rook_rec(const char *, const blasint *, const blasint *, blasint *,
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.
@ -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
* */
void RELAPACK_zhetrf_rook(
const char *uplo, const int *n,
double *A, const int *ldA, int *ipiv,
double *Work, const int *lWork, int *info
const char *uplo, const blasint *n,
double *A, const blasint *ldA, blasint *ipiv,
double *Work, const blasint *lWork, blasint *info
) {
// Required work size
const int cleanlWork = *n * (*n / 2);
int minlWork = cleanlWork;
const blasint cleanlWork = *n * (*n / 2);
blasint minlWork = cleanlWork;
#if XSYTRF_ALLOW_MALLOC
minlWork = 1;
#endif
// Check arguments
const int lower = LAPACK(lsame)(uplo, "L");
const int upper = LAPACK(lsame)(uplo, "U");
const blasint lower = LAPACK(lsame)(uplo, "L");
const blasint upper = LAPACK(lsame)(uplo, "U");
*info = 0;
if (!lower && !upper)
*info = -1;
@ -55,8 +55,8 @@ void RELAPACK_zhetrf_rook(
#endif
if (*info) {
const int minfo = -*info;
LAPACK(xerbla)("ZHETRF", &minfo);
const blasint minfo = -*info;
LAPACK(xerbla)("ZHETRF", &minfo, strlen("ZHETRF"));
return;
}
@ -64,7 +64,7 @@ void RELAPACK_zhetrf_rook(
const char cleanuplo = lower ? 'L' : 'U';
// Dummy argument
int nout;
blasint nout;
// Recursive kernel
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 */
static void RELAPACK_zhetrf_rook_rec(
const char *uplo, const int *n_full, const int *n, int *n_out,
double *A, const int *ldA, int *ipiv,
double *Work, const int *ldWork, int *info
const char *uplo, const blasint *n_full, const blasint *n, blasint *n_out,
double *A, const blasint *ldA, blasint *ipiv,
double *Work, const blasint *ldWork, blasint *info
) {
// top recursion level?
const int top = *n_full == *n;
const blasint top = *n_full == *n;
if (*n <= MAX(CROSSOVER_ZHETRF_ROOK, 3)) {
// Unblocked
@ -96,31 +96,31 @@ static void RELAPACK_zhetrf_rook_rec(
return;
}
int info1, info2;
blasint info1, info2;
// Constants
const double ONE[] = { 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') {
// Splitting (setup)
int n1 = ZREC_SPLIT(*n);
int n2 = *n - n1;
blasint n1 = ZREC_SPLIT(*n);
blasint n2 = *n - n1;
// Work_L *
double *const Work_L = Work;
// 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);
n1 = n1_out;
// Splitting (continued)
n2 = *n - n1;
const int n_full2 = *n_full - n1;
const blasint n_full2 = *n_full - n1;
// * *
// A_BL A_BR
@ -136,23 +136,23 @@ static void RELAPACK_zhetrf_rook_rec(
// (top recursion level: use Work as Work_BR)
double *const Work_BL = Work + 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_B
int *const ipiv_B = ipiv + n1;
blasint *const ipiv_B = ipiv + n1;
// 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);
BLAS(zgemm)("N", "T", &n_rest, &n2, &n1, MONE, A_BL_B, ldA, Work_BL, ldWork, ONE, A_BR_B, ldA);
// 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);
if (n2_out != n2) {
// undo 1 column of updates
const int n_restp1 = n_rest + 1;
const blasint n_restp1 = n_rest + 1;
// last column of A_BR
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;
// shift pivots
int i;
blasint i;
for (i = 0; i < n2; i++)
if (ipiv_B[i] > 0)
ipiv_B[i] += n1;
@ -180,22 +180,22 @@ static void RELAPACK_zhetrf_rook_rec(
*n_out = n1 + n2;
} else {
// Splitting (setup)
int n2 = ZREC_SPLIT(*n);
int n1 = *n - n2;
blasint n2 = ZREC_SPLIT(*n);
blasint n1 = *n - n2;
// * Work_R
// (top recursion level: use Work as Work_R)
double *const Work_R = top ? Work : Work + 2 * *ldWork * n1;
// 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);
const int n2_diff = n2 - n2_out;
const blasint n2_diff = n2 - n2_out;
n2 = n2_out;
// Splitting (continued)
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 A_TR
@ -211,19 +211,19 @@ static void RELAPACK_zhetrf_rook_rec(
// (top recursion level: Work_R was Work)
double *const Work_L = Work;
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'
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);
// 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);
if (n1_out != n1) {
// 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'
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 */
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
*
@ -24,12 +24,12 @@ static int c__1 = 1;
* The blocked BLAS Level 3 updates were removed and moved to the
* recursive algorithm.
* */
/* Subroutine */ void RELAPACK_zhetrf_rook_rec2(char *uplo, int *n,
int *nb, int *kb, doublecomplex *a, int *lda, int *
ipiv, doublecomplex *w, int *ldw, int *info, ftnlen uplo_len)
/* Subroutine */ void RELAPACK_zhetrf_rook_rec2(char *uplo, blasint *n,
int *nb, blasint *kb, doublecomplex *a, blasint *lda, blasint *
ipiv, doublecomplex *w, blasint *ldw, blasint *info, ftnlen uplo_len)
{
/* 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;
doublecomplex z__1, z__2, z__3, z__4, z__5;
@ -39,30 +39,30 @@ static int c__1 = 1;
doublecomplex *, doublecomplex *);
/* Local variables */
static int j, k, p;
static blasint j, k, p;
static double t, r1;
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 int imax, jmax;
static blasint imax, jmax;
static double alpha;
extern logical lsame_(char *, char *, ftnlen, ftnlen);
static double dtemp, sfmin;
static int itemp, kstep;
extern /* Subroutine */ int zgemv_(char *, int *, int *,
doublecomplex *, doublecomplex *, int *, doublecomplex *,
int *, doublecomplex *, doublecomplex *, int *, ftnlen),
zcopy_(int *, doublecomplex *, int *, doublecomplex *,
int *), zswap_(int *, doublecomplex *, int *,
doublecomplex *, int *);
static blasint itemp, kstep;
extern /* Subroutine */ blasint zgemv_(char *, blasint *, blasint *,
doublecomplex *, doublecomplex *, blasint *, doublecomplex *,
blasint *, doublecomplex *, doublecomplex *, blasint *, ftnlen),
zcopy_(int *, doublecomplex *, blasint *, doublecomplex *,
blasint *), zswap_(int *, doublecomplex *, blasint *,
doublecomplex *, blasint *);
extern double dlamch_(char *, ftnlen);
static double absakk;
extern /* Subroutine */ int zdscal_(int *, double *,
doublecomplex *, int *);
extern /* Subroutine */ blasint zdscal_(int *, double *,
doublecomplex *, blasint *);
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;
/* Parameter adjustments */

28
relapack/src/zlauum.c
View File

@ -1,7 +1,7 @@
#include "relapack.h"
static void RELAPACK_zlauum_rec(const char *, const int *, double *,
const int *, int *);
static void RELAPACK_zlauum_rec(const char *, const blasint *, double *,
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.
@ -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
* */
void RELAPACK_zlauum(
const char *uplo, const int *n,
double *A, const int *ldA,
int *info
const char *uplo, const blasint *n,
double *A, const blasint *ldA,
blasint *info
) {
// Check arguments
const int lower = LAPACK(lsame)(uplo, "L");
const int upper = LAPACK(lsame)(uplo, "U");
const blasint lower = LAPACK(lsame)(uplo, "L");
const blasint upper = LAPACK(lsame)(uplo, "U");
*info = 0;
if (!lower && !upper)
*info = -1;
@ -27,8 +27,8 @@ void RELAPACK_zlauum(
else if (*ldA < MAX(1, *n))
*info = -4;
if (*info) {
const int minfo = -*info;
LAPACK(xerbla)("ZLAUUM", &minfo);
const blasint minfo = -*info;
LAPACK(xerbla)("ZLAUUM", &minfo, strlen("ZLAUUM"));
return;
}
@ -42,9 +42,9 @@ void RELAPACK_zlauum(
/** zlauum's recursive compute kernel */
static void RELAPACK_zlauum_rec(
const char *uplo, const int *n,
double *A, const int *ldA,
int *info
const char *uplo, const blasint *n,
double *A, const blasint *ldA,
blasint *info
) {
if (*n <= MAX(CROSSOVER_ZLAUUM, 1)) {
@ -57,8 +57,8 @@ static void RELAPACK_zlauum_rec(
const double ONE[] = { 1., 0. };
// Splitting
const int n1 = ZREC_SPLIT(*n);
const int n2 = *n - n1;
const blasint n1 = ZREC_SPLIT(*n);
const blasint n2 = *n - n1;
// A_TL A_TR
// A_BL A_BR

42
relapack/src/zpbtrf.c
View File

@ -1,8 +1,8 @@
#include "relapack.h"
#include "stdlib.h"
static void RELAPACK_zpbtrf_rec(const char *, const int *, const int *,
double *, const int *, double *, const int *, int *);
static void RELAPACK_zpbtrf_rec(const char *, const blasint *, const blasint *,
double *, const blasint *, double *, const blasint *, blasint *);
/** 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
* */
void RELAPACK_zpbtrf(
const char *uplo, const int *n, const int *kd,
double *Ab, const int *ldAb,
int *info
const char *uplo, const blasint *n, const blasint *kd,
double *Ab, const blasint *ldAb,
blasint *info
) {
// Check arguments
const int lower = LAPACK(lsame)(uplo, "L");
const int upper = LAPACK(lsame)(uplo, "U");
const blasint lower = LAPACK(lsame)(uplo, "L");
const blasint upper = LAPACK(lsame)(uplo, "U");
*info = 0;
if (!lower && !upper)
*info = -1;
@ -30,8 +30,8 @@ void RELAPACK_zpbtrf(
else if (*ldAb < *kd + 1)
*info = -5;
if (*info) {
const int minfo = -*info;
LAPACK(xerbla)("ZPBTRF", &minfo);
const blasint minfo = -*info;
LAPACK(xerbla)("ZPBTRF", &minfo, strlen("ZPBTRF"));
return;
}
@ -42,9 +42,9 @@ void RELAPACK_zpbtrf(
const double ZERO[] = { 0., 0. };
// Allocate work space
const int n1 = ZREC_SPLIT(*n);
const int mWork = (*kd > n1) ? (lower ? *n - *kd : n1) : *kd;
const int nWork = (*kd > n1) ? (lower ? n1 : *n - *kd) : *kd;
const blasint n1 = ZREC_SPLIT(*n);
const blasint mWork = (*kd > n1) ? (lower ? *n - *kd : n1) : *kd;
const blasint nWork = (*kd > n1) ? (lower ? n1 : *n - *kd) : *kd;
double *Work = malloc(mWork * nWork * 2 * sizeof(double));
LAPACK(zlaset)(uplo, &mWork, &nWork, ZERO, ZERO, Work, &mWork);
@ -58,10 +58,10 @@ void RELAPACK_zpbtrf(
/** zpbtrf's recursive compute kernel */
static void RELAPACK_zpbtrf_rec(
const char *uplo, const int *n, const int *kd,
double *Ab, const int *ldAb,
double *Work, const int *ldWork,
int *info
const char *uplo, const blasint *n, const blasint *kd,
double *Ab, const blasint *ldAb,
double *Work, const blasint *ldWork,
blasint *info
){
if (*n <= MAX(CROSSOVER_ZPBTRF, 1)) {
@ -75,12 +75,12 @@ static void RELAPACK_zpbtrf_rec(
const double MONE[] = { -1., 0. };
// Unskew A
const int ldA[] = { *ldAb - 1 };
const blasint ldA[] = { *ldAb - 1 };
double *const A = Ab + 2 * ((*uplo == 'L') ? 0 : *kd);
// Splitting
const int n1 = MIN(ZREC_SPLIT(*n), *kd);
const int n2 = *n - n1;
const blasint n1 = MIN(ZREC_SPLIT(*n), *kd);
const blasint n2 = *n - n1;
// * *
// * Ab_BR
@ -99,8 +99,8 @@ static void RELAPACK_zpbtrf_rec(
return;
// Banded splitting
const int n21 = MIN(n2, *kd - n1);
const int n22 = MIN(n2 - n21, *kd);
const blasint n21 = MIN(n2, *kd - n1);
const blasint n22 = MIN(n2 - n21, *kd);
// n1 n21 n22
// n1 * A_TRl A_TRr

28
relapack/src/zpotrf.c
View File

@ -1,7 +1,7 @@
#include "relapack.h"
static void RELAPACK_zpotrf_rec(const char *, const int *, double *,
const int *, int *);
static void RELAPACK_zpotrf_rec(const char *, const blasint *, double *,
const blasint *, blasint *);
/** 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
* */
void RELAPACK_zpotrf(
const char *uplo, const int *n,
double *A, const int *ldA,
int *info
const char *uplo, const blasint *n,
double *A, const blasint *ldA,
blasint *info
) {
// Check arguments
const int lower = LAPACK(lsame)(uplo, "L");
const int upper = LAPACK(lsame)(uplo, "U");
const blasint lower = LAPACK(lsame)(uplo, "L");
const blasint upper = LAPACK(lsame)(uplo, "U");
*info = 0;
if (!lower && !upper)
*info = -1;
@ -27,8 +27,8 @@ void RELAPACK_zpotrf(
else if (*ldA < MAX(1, *n))
*info = -4;
if (*info) {
const int minfo = -*info;
LAPACK(xerbla)("ZPOTRF", &minfo);
const blasint minfo = -*info;
LAPACK(xerbla)("ZPOTRF", &minfo, strlen("ZPOTRF"));
return;
}
@ -42,9 +42,9 @@ void RELAPACK_zpotrf(
/** zpotrf's recursive compute kernel */
static void RELAPACK_zpotrf_rec(
const char *uplo, const int *n,
double *A, const int *ldA,
int *info
const char *uplo, const blasint *n,
double *A, const blasint *ldA,
blasint *info
) {
if (*n <= MAX(CROSSOVER_ZPOTRF, 1)) {
@ -58,8 +58,8 @@ static void RELAPACK_zpotrf_rec(
const double MONE[] = { -1., 0. };
// Splitting
const int n1 = ZREC_SPLIT(*n);
const int n2 = *n - n1;
const blasint n1 = ZREC_SPLIT(*n);
const blasint n2 = *n - n1;
// A_TL A_TR
// A_BL A_BR

72
relapack/src/zsytrf.c
View File

@ -3,8 +3,8 @@
#include <stdlib.h>
#endif
static void RELAPACK_zsytrf_rec(const char *, const int *, const int *, int *,
double *, const int *, int *, double *, const int *, int *);
static void RELAPACK_zsytrf_rec(const char *, const blasint *, const blasint *, blasint *,
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.
@ -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
* */
void RELAPACK_zsytrf(
const char *uplo, const int *n,
double *A, const int *ldA, int *ipiv,
double *Work, const int *lWork, int *info
const char *uplo, const blasint *n,
double *A, const blasint *ldA, blasint *ipiv,
double *Work, const blasint *lWork, blasint *info
) {
// Required work size
const int cleanlWork = *n * (*n / 2);
int minlWork = cleanlWork;
const blasint cleanlWork = *n * (*n / 2);
blasint minlWork = cleanlWork;
#if XSYTRF_ALLOW_MALLOC
minlWork = 1;
#endif
// Check arguments
const int lower = LAPACK(lsame)(uplo, "L");
const int upper = LAPACK(lsame)(uplo, "U");
const blasint lower = LAPACK(lsame)(uplo, "L");
const blasint upper = LAPACK(lsame)(uplo, "U");
*info = 0;
if (!lower && !upper)
*info = -1;
@ -55,8 +55,8 @@ void RELAPACK_zsytrf(
#endif
if (*info) {
const int minfo = -*info;
LAPACK(xerbla)("ZSYTRF", &minfo);
const blasint minfo = -*info;
LAPACK(xerbla)("ZSYTRF", &minfo, strlen("ZSYTRF"));
return;
}
@ -64,7 +64,7 @@ void RELAPACK_zsytrf(
const char cleanuplo = lower ? 'L' : 'U';
// Dummy arguments
int nout;
blasint nout;
// Recursive kernel
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 */
static void RELAPACK_zsytrf_rec(
const char *uplo, const int *n_full, const int *n, int *n_out,
double *A, const int *ldA, int *ipiv,
double *Work, const int *ldWork, int *info
const char *uplo, const blasint *n_full, const blasint *n, blasint *n_out,
double *A, const blasint *ldA, blasint *ipiv,
double *Work, const blasint *ldWork, blasint *info
) {
// top recursion level?
const int top = *n_full == *n;
const blasint top = *n_full == *n;
if (*n <= MAX(CROSSOVER_ZSYTRF, 3)) {
// Unblocked
@ -96,34 +96,34 @@ static void RELAPACK_zsytrf_rec(
return;
}
int info1, info2;
blasint info1, info2;
// Constants
const double ONE[] = { 1., 0. };
const double MONE[] = { -1., 0. };
const int iONE[] = { 1 };
const blasint iONE[] = { 1 };
// Loop iterator
int i;
blasint i;
const int n_rest = *n_full - *n;
const blasint n_rest = *n_full - *n;
if (*uplo == 'L') {
// Splitting (setup)
int n1 = ZREC_SPLIT(*n);
int n2 = *n - n1;
blasint n1 = ZREC_SPLIT(*n);
blasint n2 = *n - n1;
// Work_L *
double *const Work_L = Work;
// 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);
n1 = n1_out;
// Splitting (continued)
n2 = *n - n1;
const int n_full2 = *n_full - n1;
const blasint n_full2 = *n_full - n1;
// * *
// A_BL A_BR
@ -139,23 +139,23 @@ static void RELAPACK_zsytrf_rec(
// (top recursion level: use Work as Work_BR)
double *const Work_BL = Work + 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_B
int *const ipiv_B = ipiv + n1;
blasint *const ipiv_B = ipiv + n1;
// 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);
BLAS(zgemm)("N", "T", &n_rest, &n2, &n1, MONE, A_BL_B, ldA, Work_BL, ldWork, ONE, A_BR_B, ldA);
// 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);
if (n2_out != n2) {
// undo 1 column of updates
const int n_restp1 = n_rest + 1;
const blasint n_restp1 = n_rest + 1;
// last column of A_BR
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;
} else {
// Splitting (setup)
int n2 = ZREC_SPLIT(*n);
int n1 = *n - n2;
blasint n2 = ZREC_SPLIT(*n);
blasint n1 = *n - n2;
// * Work_R
// (top recursion level: use Work as Work_R)
double *const Work_R = top ? Work : Work + 2 * *ldWork * n1;
// 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);
const int n2_diff = n2 - n2_out;
const blasint n2_diff = n2 - n2_out;
n2 = n2_out;
// Splitting (continued)
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 A_TR
@ -213,19 +213,19 @@ static void RELAPACK_zsytrf_rec(
// (top recursion level: Work_R was Work)
double *const Work_L = Work;
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'
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);
// 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);
if (n1_out != n1) {
// 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'
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 */
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.
*
@ -24,12 +24,12 @@ static int c__1 = 1;
* The blocked BLAS Level 3 updates were removed and moved to the
* recursive algorithm.
* */
/* Subroutine */ void RELAPACK_zsytrf_rec2(char *uplo, int *n, int *
nb, int *kb, doublecomplex *a, int *lda, int *ipiv,
doublecomplex *w, int *ldw, int *info, ftnlen uplo_len)
/* Subroutine */ void RELAPACK_zsytrf_rec2(char *uplo, blasint *n, blasint *
nb, blasint *kb, doublecomplex *a, blasint *lda, blasint *ipiv,
doublecomplex *w, blasint *ldw, blasint *info, ftnlen uplo_len)
{
/* 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;
doublecomplex z__1, z__2, z__3;
@ -38,22 +38,22 @@ static int c__1 = 1;
void z_div(doublecomplex *, doublecomplex *, doublecomplex *);
/* Local variables */
static int j, k;
static blasint j, k;
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;
extern logical lsame_(char *, char *, ftnlen, ftnlen);
extern /* Subroutine */ int zscal_(int *, doublecomplex *,
doublecomplex *, int *);
static int kstep;
extern /* Subroutine */ int zgemv_(char *, int *, int *,
doublecomplex *, doublecomplex *, int *, doublecomplex *,
int *, doublecomplex *, doublecomplex *, int *, ftnlen),
zcopy_(int *, doublecomplex *, int *, doublecomplex *,
int *), zswap_(int *, doublecomplex *, int *,
doublecomplex *, int *);
extern /* Subroutine */ blasint zscal_(int *, doublecomplex *,
doublecomplex *, blasint *);
static blasint kstep;
extern /* Subroutine */ blasint zgemv_(char *, blasint *, blasint *,
doublecomplex *, doublecomplex *, blasint *, doublecomplex *,
blasint *, doublecomplex *, doublecomplex *, blasint *, ftnlen),
zcopy_(int *, doublecomplex *, blasint *, doublecomplex *,
blasint *), zswap_(int *, doublecomplex *, blasint *,
doublecomplex *, blasint *);
static double absakk, colmax;
extern int izamax_(int *, doublecomplex *, int *);
extern blasint izamax_(int *, doublecomplex *, blasint *);
static double rowmax;
/* Parameter adjustments */

72
relapack/src/zsytrf_rook.c
View File

@ -3,8 +3,8 @@
#include <stdlib.h>
#endif
static void RELAPACK_zsytrf_rook_rec(const char *, const int *, const int *, int *,
double *, const int *, int *, double *, const int *, int *);
static void RELAPACK_zsytrf_rook_rec(const char *, const blasint *, const blasint *, blasint *,
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.
@ -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
* */
void RELAPACK_zsytrf_rook(
const char *uplo, const int *n,
double *A, const int *ldA, int *ipiv,
double *Work, const int *lWork, int *info
const char *uplo, const blasint *n,
double *A, const blasint *ldA, blasint *ipiv,
double *Work, const blasint *lWork, blasint *info
) {
// Required work size
const int cleanlWork = *n * (*n / 2);
int minlWork = cleanlWork;
const blasint cleanlWork = *n * (*n / 2);
blasint minlWork = cleanlWork;
#if XSYTRF_ALLOW_MALLOC
minlWork = 1;
#endif
// Check arguments
const int lower = LAPACK(lsame)(uplo, "L");
const int upper = LAPACK(lsame)(uplo, "U");
const blasint lower = LAPACK(lsame)(uplo, "L");
const blasint upper = LAPACK(lsame)(uplo, "U");
*info = 0;
if (!lower && !upper)
*info = -1;
@ -55,8 +55,8 @@ void RELAPACK_zsytrf_rook(
#endif
if (*info) {
const int minfo = -*info;
LAPACK(xerbla)("ZSYTRF", &minfo);
const blasint minfo = -*info;
LAPACK(xerbla)("ZSYTRF", &minfo, strlen("ZSYTRF"));
return;
}
@ -64,7 +64,7 @@ void RELAPACK_zsytrf_rook(
const char cleanuplo = lower ? 'L' : 'U';
// Dummy argument
int nout;
blasint nout;
// Recursive kernel
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 */
static void RELAPACK_zsytrf_rook_rec(
const char *uplo, const int *n_full, const int *n, int *n_out,
double *A, const int *ldA, int *ipiv,
double *Work, const int *ldWork, int *info
const char *uplo, const blasint *n_full, const blasint *n, blasint *n_out,
double *A, const blasint *ldA, blasint *ipiv,
double *Work, const blasint *ldWork, blasint *info
) {
// top recursion level?
const int top = *n_full == *n;
const blasint top = *n_full == *n;
if (*n <= MAX(CROSSOVER_ZSYTRF_ROOK, 3)) {
// Unblocked
@ -96,31 +96,31 @@ static void RELAPACK_zsytrf_rook_rec(
return;
}
int info1, info2;
blasint info1, info2;
// Constants
const double ONE[] = { 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') {
// Splitting (setup)
int n1 = ZREC_SPLIT(*n);
int n2 = *n - n1;
blasint n1 = ZREC_SPLIT(*n);
blasint n2 = *n - n1;
// Work_L *
double *const Work_L = Work;
// 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);
n1 = n1_out;
// Splitting (continued)
n2 = *n - n1;
const int n_full2 = *n_full - n1;
const blasint n_full2 = *n_full - n1;
// * *
// A_BL A_BR
@ -136,23 +136,23 @@ static void RELAPACK_zsytrf_rook_rec(
// (top recursion level: use Work as Work_BR)
double *const Work_BL = Work + 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_B
int *const ipiv_B = ipiv + n1;
blasint *const ipiv_B = ipiv + n1;
// 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);
BLAS(zgemm)("N", "T", &n_rest, &n2, &n1, MONE, A_BL_B, ldA, Work_BL, ldWork, ONE, A_BR_B, ldA);
// 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);
if (n2_out != n2) {
// undo 1 column of updates
const int n_restp1 = n_rest + 1;
const blasint n_restp1 = n_rest + 1;
// last column of A_BR
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;
// shift pivots
int i;
blasint i;
for (i = 0; i < n2; i++)
if (ipiv_B[i] > 0)
ipiv_B[i] += n1;
@ -180,22 +180,22 @@ static void RELAPACK_zsytrf_rook_rec(
*n_out = n1 + n2;
} else {
// Splitting (setup)
int n2 = ZREC_SPLIT(*n);
int n1 = *n - n2;
blasint n2 = ZREC_SPLIT(*n);
blasint n1 = *n - n2;
// * Work_R
// (top recursion level: use Work as Work_R)
double *const Work_R = top ? Work : Work + 2 * *ldWork * n1;
// 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);
const int n2_diff = n2 - n2_out;
const blasint n2_diff = n2 - n2_out;
n2 = n2_out;
// Splitting (continued)
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 A_TR
@ -211,19 +211,19 @@ static void RELAPACK_zsytrf_rook_rec(
// (top recursion level: Work_R was Work)
double *const Work_L = Work;
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'
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);
// 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);
if (n1_out != n1) {
// 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'
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 */
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.
*
@ -24,12 +24,12 @@ static int c__1 = 1;
* The blocked BLAS Level 3 updates were removed and moved to the
* recursive algorithm.
* */
/* Subroutine */ void RELAPACK_zsytrf_rook_rec2(char *uplo, int *n,
int *nb, int *kb, doublecomplex *a, int *lda, int *
ipiv, doublecomplex *w, int *ldw, int *info, ftnlen uplo_len)
/* Subroutine */ void RELAPACK_zsytrf_rook_rec2(char *uplo, blasint *n,
int *nb, blasint *kb, doublecomplex *a, blasint *lda, blasint *
ipiv, doublecomplex *w, blasint *ldw, blasint *info, ftnlen uplo_len)
{
/* 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;
doublecomplex z__1, z__2, z__3, z__4;
@ -38,26 +38,26 @@ static int c__1 = 1;
void z_div(doublecomplex *, doublecomplex *, doublecomplex *);
/* Local variables */
static int j, k, p;
static blasint j, k, p;
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 int imax, jmax;
static blasint imax, jmax;
static double alpha;
extern logical lsame_(char *, char *, ftnlen, ftnlen);
static double dtemp, sfmin;
extern /* Subroutine */ int zscal_(int *, doublecomplex *,
doublecomplex *, int *);
static int itemp, kstep;
extern /* Subroutine */ int zgemv_(char *, int *, int *,
doublecomplex *, doublecomplex *, int *, doublecomplex *,
int *, doublecomplex *, doublecomplex *, int *, ftnlen),
zcopy_(int *, doublecomplex *, int *, doublecomplex *,
int *), zswap_(int *, doublecomplex *, int *,
doublecomplex *, int *);
extern /* Subroutine */ blasint zscal_(int *, doublecomplex *,
doublecomplex *, blasint *);
static blasint itemp, kstep;
extern /* Subroutine */ blasint zgemv_(char *, blasint *, blasint *,
doublecomplex *, doublecomplex *, blasint *, doublecomplex *,
blasint *, doublecomplex *, doublecomplex *, blasint *, ftnlen),
zcopy_(int *, doublecomplex *, blasint *, doublecomplex *,
blasint *), zswap_(int *, doublecomplex *, blasint *,
doublecomplex *, blasint *);
extern double dlamch_(char *, ftnlen);
static double absakk, colmax;
extern int izamax_(int *, doublecomplex *, int *);
extern blasint izamax_(int *, doublecomplex *, blasint *);
static double rowmax;
/* Parameter adjustments */

62
relapack/src/ztgsyl.c
View File

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

52
relapack/src/ztrsyl.c
View File

@ -1,8 +1,8 @@
#include "relapack.h"
static void RELAPACK_ztrsyl_rec(const char *, const char *, const int *,
const int *, const int *, const double *, const int *, const double *,
const int *, double *, const int *, double *, int *);
static void RELAPACK_ztrsyl_rec(const char *, const char *, const blasint *,
const blasint *, const blasint *, const double *, const blasint *, const double *,
const blasint *, double *, const blasint *, double *, blasint *);
/** 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
* */
void RELAPACK_ztrsyl(
const char *tranA, const char *tranB, const int *isgn,
const int *m, const int *n,
const double *A, const int *ldA, const double *B, const int *ldB,
double *C, const int *ldC, double *scale,
int *info
const char *tranA, const char *tranB, const blasint *isgn,
const blasint *m, const blasint *n,
const double *A, const blasint *ldA, const double *B, const blasint *ldB,
double *C, const blasint *ldC, double *scale,
blasint *info
) {
// Check arguments
const int notransA = LAPACK(lsame)(tranA, "N");
const int ctransA = LAPACK(lsame)(tranA, "C");
const int notransB = LAPACK(lsame)(tranB, "N");
const int ctransB = LAPACK(lsame)(tranB, "C");
const blasint notransA = LAPACK(lsame)(tranA, "N");
const blasint ctransA = LAPACK(lsame)(tranA, "C");
const blasint notransB = LAPACK(lsame)(tranB, "N");
const blasint ctransB = LAPACK(lsame)(tranB, "C");
*info = 0;
if (!ctransA && !notransA)
*info = -1;
@ -42,8 +42,8 @@ void RELAPACK_ztrsyl(
else if (*ldC < MAX(1, *m))
*info = -11;
if (*info) {
const int minfo = -*info;
LAPACK(xerbla)("ZTRSYL", &minfo);
const blasint minfo = -*info;
LAPACK(xerbla)("ZTRSYL", &minfo, strlen("ZTRSYL"));
return;
}
@ -58,11 +58,11 @@ void RELAPACK_ztrsyl(
/** ztrsyl's recursive compute kernel */
static void RELAPACK_ztrsyl_rec(
const char *tranA, const char *tranB, const int *isgn,
const int *m, const int *n,
const double *A, const int *ldA, const double *B, const int *ldB,
double *C, const int *ldC, double *scale,
int *info
const char *tranA, const char *tranB, const blasint *isgn,
const blasint *m, const blasint *n,
const double *A, const blasint *ldA, const double *B, const blasint *ldB,
double *C, const blasint *ldC, double *scale,
blasint *info
) {
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 MONE[] = { -1., 0. };
const double MSGN[] = { -*isgn, 0. };
const int iONE[] = { 1 };
const blasint iONE[] = { 1 };
// Outputs
double scale1[] = { 1., 0. };
double scale2[] = { 1., 0. };
int info1[] = { 0 };
int info2[] = { 0 };
blasint info1[] = { 0 };
blasint info2[] = { 0 };
if (*m > *n) {
// Splitting
const int m1 = ZREC_SPLIT(*m);
const int m2 = *m - m1;
const blasint m1 = ZREC_SPLIT(*m);
const blasint m2 = *m - m1;
// A_TL A_TR
// 0 A_BR
@ -122,8 +122,8 @@ static void RELAPACK_ztrsyl_rec(
}
} else {
// Splitting
const int n1 = ZREC_SPLIT(*n);
const int n2 = *n - n1;
const blasint n1 = ZREC_SPLIT(*n);
const blasint n2 = *n - n1;
// B_TL B_TR
// 0 B_BR

42
relapack/src/ztrsyl_rec2.c
View File

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

34
relapack/src/ztrtri.c
View File

@ -1,7 +1,7 @@
#include "relapack.h"
static void RELAPACK_ztrtri_rec(const char *, const char *, const int *,
double *, const int *, int *);
static void RELAPACK_ztrtri_rec(const char *, const char *, const blasint *,
double *, const blasint *, blasint *);
/** 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
* */
void RELAPACK_ztrtri(
const char *uplo, const char *diag, const int *n,
double *A, const int *ldA,
int *info
const char *uplo, const char *diag, const blasint *n,
double *A, const blasint *ldA,
blasint *info
) {
// Check arguments
const int lower = LAPACK(lsame)(uplo, "L");
const int upper = LAPACK(lsame)(uplo, "U");
const int nounit = LAPACK(lsame)(diag, "N");
const int unit = LAPACK(lsame)(diag, "U");
const blasint lower = LAPACK(lsame)(uplo, "L");
const blasint upper = LAPACK(lsame)(uplo, "U");
const blasint nounit = LAPACK(lsame)(diag, "N");
const blasint unit = LAPACK(lsame)(diag, "U");
*info = 0;
if (!lower && !upper)
*info = -1;
@ -31,8 +31,8 @@ void RELAPACK_ztrtri(
else if (*ldA < MAX(1, *n))
*info = -5;
if (*info) {
const int minfo = -*info;
LAPACK(xerbla)("ZTRTRI", &minfo);
const blasint minfo = -*info;
LAPACK(xerbla)("ZTRTRI", &minfo, strlen("ZTRTRI"));
return;
}
@ -42,7 +42,7 @@ void RELAPACK_ztrtri(
// check for singularity
if (nounit) {
int i;
blasint i;
for (i = 0; i < *n; i++)
if (A[2 * (i + *ldA * i)] == 0 && A[2 * (i + *ldA * i) + 1] == 0) {
*info = i;
@ -57,9 +57,9 @@ void RELAPACK_ztrtri(
/** ztrtri's recursive compute kernel */
static void RELAPACK_ztrtri_rec(
const char *uplo, const char *diag, const int *n,
double *A, const int *ldA,
int *info
const char *uplo, const char *diag, const blasint *n,
double *A, const blasint *ldA,
blasint *info
){
if (*n <= MAX(CROSSOVER_ZTRTRI, 1)) {
@ -73,8 +73,8 @@ static void RELAPACK_ztrtri_rec(
const double MONE[] = { -1. };
// Splitting
const int n1 = ZREC_SPLIT(*n);
const int n2 = *n - n1;
const blasint n1 = ZREC_SPLIT(*n);
const blasint n2 = *n - n1;
// A_TL A_TR
// A_BL A_BR