#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(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(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(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(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(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(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(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(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(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(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 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 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 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 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 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 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 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 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 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 */
#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.
* 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
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;
}
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++)
}
// 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);
/** 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)) {
// 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
// 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
// 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);
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];
// 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);
#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
* */
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
#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)
else if (*ldC < MAX(1, *n))
info = 13;
if (info) {
- LAPACK(xerbla)("CGEMMT", &info);
+ LAPACK(xerbla)("CGEMMT", &info, strlen("CGEMMT"));
return;
}
/** 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)) {
}
// 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
/** 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
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
#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.
* 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
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);
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;
/** 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)) {
// 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;
// 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);
// 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;
}
#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.
* 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;
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;
}
// 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)
/** 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)) {
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
#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.
* 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;
#endif
if (*info) {
- const int minfo = -*info;
- LAPACK(xerbla)("CHETRF", &minfo);
+ const blasint minfo = -*info;
+ LAPACK(xerbla)("CHETRF", &minfo, strlen("CHETRF"));
return;
}
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);
/** 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
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
// (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;
n2 = n2_out;
// shift pivots
- int i;
+ blasint i;
for (i = 0; i < n2; i++)
if (ipiv_B[i] > 0)
ipiv_B[i] += n1;
*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
// (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);
/* 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
*
* 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;
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;
#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.
* 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;
#endif
if (*info) {
- const int minfo = -*info;
- LAPACK(xerbla)("CHETRF", &minfo);
+ const blasint minfo = -*info;
+ LAPACK(xerbla)("CHETRF", &minfo, strlen("CHETRF"));
return;
}
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);
/** 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
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
// (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;
n2 = n2_out;
// shift pivots
- int i;
+ blasint i;
for (i = 0; i < n2; i++)
if (ipiv_B[i] > 0)
ipiv_B[i] += n1;
*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
// (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);
/* 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
*
* 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;
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;
#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.
* 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;
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;
}
/** 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)) {
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
#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.
* 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;
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;
}
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);
/** 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)) {
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
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
#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.
* 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;
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;
}
/** 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)) {
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
#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.
* 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;
#endif
if (*info) {
- const int minfo = -*info;
- LAPACK(xerbla)("CSYTRF", &minfo);
+ const blasint minfo = -*info;
+ LAPACK(xerbla)("CSYTRF", &minfo, strlen("CSYTRF"));
return;
}
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);
/** 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
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
// (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;
*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
// (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);
/* 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.
*
* 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;
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 */
#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.
* 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;
#endif
if (*info) {
- const int minfo = -*info;
- LAPACK(xerbla)("CSYTRF", &minfo);
+ const blasint minfo = -*info;
+ LAPACK(xerbla)("CSYTRF", &minfo, strlen("CSYTRF"));
return;
}
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);
/** 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
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
// (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;
n2 = n2_out;
// shift pivots
- int i;
+ blasint i;
for (i = 0; i < n2; i++)
if (ipiv_B[i] > 0)
ipiv_B[i] += n1;
*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
// (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);
/* 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.
*
* 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;
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;
#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.
* 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;
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;
}
// 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;
}
float scale2;
- int iround;
+ blasint iround;
for (iround = 1; iround <= isolve; iround++) {
*scale = 1;
float dscale = 0;
/** 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)) {
// 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
}
} 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
#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.
* 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;
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;
}
/** 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)) {
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
}
} 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
#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;
/* 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)
*
* 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;
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;
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 */
#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.
* 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;
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;
}
// 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;
/** 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)) {
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
#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.
* 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
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;
}
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++)
}
// 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);
/** 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)) {
// 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
// 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
// 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);
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];
// 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);
#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
* */
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
#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)
else if (*ldC < MAX(1, *n))
info = 13;
if (info) {
- LAPACK(xerbla)("DGEMMT", &info);
+ LAPACK(xerbla)("DGEMMT", &info, strlen("DGEMMT"));
return;
}
/** 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)) {
}
// 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
/** 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
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
#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.
* 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
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);
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;
/** 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)) {
// 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;
// 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);
// 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;
}
#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.
* 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;
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;
}
/** 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)) {
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
#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.
* 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;
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;
}
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);
/** 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)) {
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
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
#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.
* 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;
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;
}
/** 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)) {
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
#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.
* 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;
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;
}
// 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;
/** 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)) {
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
#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.
* 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;
#endif
if (*info) {
- const int minfo = -*info;
- LAPACK(xerbla)("DSYTRF", &minfo);
+ const blasint minfo = -*info;
+ LAPACK(xerbla)("DSYTRF", &minfo, strlen("DSYTRF"));
return;
}
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);
/** 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
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
// (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;
*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
// (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);
/* Table of constant values */
-static int c__1 = 1;
+static blasint c__1 = 1;
static double c_b8 = -1.;
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 */
#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.
* 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;
#endif
if (*info) {
- const int minfo = -*info;
- LAPACK(xerbla)("DSYTRF", &minfo);
+ const blasint minfo = -*info;
+ LAPACK(xerbla)("DSYTRF", &minfo, strlen("DSYTRF"));
return;
}
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);
/** 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
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
// (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;
n2 = n2_out;
// shift pivots
- int i;
+ blasint i;
for (i = 0; i < n2; i++)
if (ipiv_B[i] > 0)
ipiv_B[i] += n1;
*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
// (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);
/* Table of constant values */
-static int c__1 = 1;
+static blasint c__1 = 1;
static double c_b9 = -1.;
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 */
#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.
* 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;
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;
}
// 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;
}
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)
/** 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)) {
// 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
}
} 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
#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.
* 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;
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;
}
/** 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)) {
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
}
} 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
/* 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 */
#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.
* 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;
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;
}
// check for singularity
if (nounit) {
- int i;
+ blasint i;
for (i = 0; i < *n; i++)
if (A[i + *ldA * i] == 0) {
*info = i;
/** 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)) {
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
#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);
#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;
#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 */
#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);
}
#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);
}
#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);
}
#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);
}
#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);
}
#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);
}
#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);
}
#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);
}
#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);
}
#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);
}
#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);
}
#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);
}
#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);
}
#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);
}
#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);
}
#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);
}
#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);
}
#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);
}
#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);
}
#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);
}
#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);
}
#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);
}
#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);
}
#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);
}
#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);
}
#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);
}
#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);
}
#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);
}
#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);
}
#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);
}
#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);
}
#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);
}
#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);
}
#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);
}
#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);
}
#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);
}
#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);
}
#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);
}
#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);
}
#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);
}
#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);
}
#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);
}
#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);
}
#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);
}
#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);
}
#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);
}
#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);
}
#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);
}
#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);
}
#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);
}
#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);
}
#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);
}
#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"
#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 */
#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.
* 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)
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;
}
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++)
}
// 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);
/** 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)) {
// 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
// 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
// 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);
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];
// 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);
#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
* */
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
#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)
else if (*ldC < MAX(1, *n))
info = 13;
if (info) {
- LAPACK(xerbla)("SGEMMT", &info);
+ LAPACK(xerbla)("SGEMMT", &info, strlen("SGEMMT"));
return;
}
/** 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)) {
}
// 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
/** 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
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
#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.
* 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
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);
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;
/** 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)) {
// 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;
// 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);
// 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;
}
#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.
* 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;
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;
}
/** 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)) {
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
#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.
* 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;
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;
}
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);
/** 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)) {
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
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
#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.
* 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;
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;
}
/** 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)) {
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
#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.
* 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;
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;
}
// 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)
/** 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)) {
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
#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.
* 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;
#endif
if (*info) {
- const int minfo = -*info;
- LAPACK(xerbla)("SSYTRF", &minfo);
+ const blasint minfo = -*info;
+ LAPACK(xerbla)("SSYTRF", &minfo, strlen("SSYTRF"));
return;
}
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);
/** 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
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
// (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;
*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
// (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);
/* 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;
* 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 */
#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.
* 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;
#endif
if (*info) {
- const int minfo = -*info;
- LAPACK(xerbla)("SSYTRF", &minfo);
+ const blasint minfo = -*info;
+ LAPACK(xerbla)("SSYTRF", &minfo, strlen("SSYTRF"));
return;
}
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);
/** 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
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
// (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;
n2 = n2_out;
// shift pivots
- int i;
+ blasint i;
for (i = 0; i < n2; i++)
if (ipiv_B[i] > 0)
ipiv_B[i] += n1;
*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
// (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);
/* 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;
* 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 */
#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.
* 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;
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;
}
// 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;
}
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)
/** 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)) {
// 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
}
} 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
#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.
* 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;
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;
}
/** 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)) {
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
}
} 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
/* 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 */
#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.
* 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;
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;
}
// check for singularity
if (nounit) {
- int i;
+ blasint i;
for (i = 0; i < *n; i++)
if (A[i + *ldA * i] == 0) {
*info = i;
/** 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)) {
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
#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.
* 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
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;
}
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++)
}
// 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);
/** 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)) {
// 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
// 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
// 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);
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];
// 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);
#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
* */
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
#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)
else if (*ldC < MAX(1, *n))
info = 13;
if (info) {
- LAPACK(xerbla)("ZGEMMT", &info);
+ LAPACK(xerbla)("ZGEMMT", &info, strlen("ZGEMMT"));
return;
}
/** 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)) {
}
// 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
/** 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
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
#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.
* 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
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);
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;
/** 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)) {
// 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;
// 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);
// 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;
}
#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.
* 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;
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;
}
// 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)
/** 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)) {
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
#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.
* 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;
#endif
if (*info) {
- const int minfo = -*info;
- LAPACK(xerbla)("ZHETRF", &minfo);
+ const blasint minfo = -*info;
+ LAPACK(xerbla)("ZHETRF", &minfo, strlen("ZHETRF"));
return;
}
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);
/** 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
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
// (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;
n2 = n2_out;
// shift pivots
- int i;
+ blasint i;
for (i = 0; i < n2; i++)
if (ipiv_B[i] > 0)
ipiv_B[i] += n1;
*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
// (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);
/* 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
*
* 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;
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 */
#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.
* 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;
#endif
if (*info) {
- const int minfo = -*info;
- LAPACK(xerbla)("ZHETRF", &minfo);
+ const blasint minfo = -*info;
+ LAPACK(xerbla)("ZHETRF", &minfo, strlen("ZHETRF"));
return;
}
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);
/** 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
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
// (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;
n2 = n2_out;
// shift pivots
- int i;
+ blasint i;
for (i = 0; i < n2; i++)
if (ipiv_B[i] > 0)
ipiv_B[i] += n1;
*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
// (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);
/* 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
*
* 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;
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 */
#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.
* 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;
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;
}
/** 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)) {
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
#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.
* 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;
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;
}
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);
/** 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)) {
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
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
#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.
* 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;
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;
}
/** 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)) {
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
#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.
* 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;
#endif
if (*info) {
- const int minfo = -*info;
- LAPACK(xerbla)("ZSYTRF", &minfo);
+ const blasint minfo = -*info;
+ LAPACK(xerbla)("ZSYTRF", &minfo, strlen("ZSYTRF"));
return;
}
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);
/** 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
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
// (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;
*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
// (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);
/* 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.
*
* 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;
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 */
#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.
* 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;
#endif
if (*info) {
- const int minfo = -*info;
- LAPACK(xerbla)("ZSYTRF", &minfo);
+ const blasint minfo = -*info;
+ LAPACK(xerbla)("ZSYTRF", &minfo, strlen("ZSYTRF"));
return;
}
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);
/** 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
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
// (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;
n2 = n2_out;
// shift pivots
- int i;
+ blasint i;
for (i = 0; i < n2; i++)
if (ipiv_B[i] > 0)
ipiv_B[i] += n1;
*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
// (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);
/* 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.
*
* 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;
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 */
#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.
* 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;
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;
}
// 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;
}
double scale2;
- int iround;
+ blasint iround;
for (iround = 1; iround <= isolve; iround++) {
*scale = 1;
double dscale = 0;
/** 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)) {
// 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
}
} 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
#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.
* 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;
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;
}
/** 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)) {
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
}
} 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
#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;
/* 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)
*
* 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;
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;
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 */
#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.
* 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;
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;
}
// 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;
/** 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)) {
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