Merge pull request #2094 from martin-frbg/issue2066
Fix ReLAPACK integration problems
This commit is contained in:
Martin Kroeker
GitHub
commit
bbd9d98664
|
|
@ -1,67 +1,79 @@
|
|||
#ifndef RELAPACK_H
|
||||
#define RELAPACK_H
|
||||
|
||||
void RELAPACK_slauum(const char *, const int *, float *, const int *, int *);
|
||||
void RELAPACK_dlauum(const char *, const int *, double *, const int *, int *);
|
||||
void RELAPACK_clauum(const char *, const int *, float *, const int *, int *);
|
||||
void RELAPACK_zlauum(const char *, const int *, double *, const int *, int *);
|
||||
#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
|
||||
|
||||
void RELAPACK_strtri(const char *, const char *, const int *, float *, const int *, int *);
|
||||
void RELAPACK_dtrtri(const char *, const char *, const int *, double *, const int *, int *);
|
||||
void RELAPACK_ctrtri(const char *, const char *, const int *, float *, const int *, int *);
|
||||
void RELAPACK_ztrtri(const char *, const char *, const int *, double *, const int *, int *);
|
||||
void RELAPACK_slauum(const char *, const blasint *, float *, const blasint *, blasint *);
|
||||
void RELAPACK_dlauum(const char *, const blasint *, double *, const blasint *, blasint *);
|
||||
void RELAPACK_clauum(const char *, const blasint *, float *, const blasint *, blasint *);
|
||||
void RELAPACK_zlauum(const char *, const blasint *, double *, const blasint *, blasint *);
|
||||
|
||||
void RELAPACK_spotrf(const char *, const int *, float *, const int *, int *);
|
||||
void RELAPACK_dpotrf(const char *, const int *, double *, const int *, int *);
|
||||
void RELAPACK_cpotrf(const char *, const int *, float *, const int *, int *);
|
||||
void RELAPACK_zpotrf(const char *, const int *, double *, const int *, int *);
|
||||
void RELAPACK_strtri(const char *, const char *, const blasint *, float *, const blasint *, blasint *);
|
||||
void RELAPACK_dtrtri(const char *, const char *, const blasint *, double *, const blasint *, blasint *);
|
||||
void RELAPACK_ctrtri(const char *, const char *, const blasint *, float *, const blasint *, blasint *);
|
||||
void RELAPACK_ztrtri(const char *, const char *, const blasint *, double *, const blasint *, blasint *);
|
||||
|
||||
void RELAPACK_spbtrf(const char *, const int *, const int *, float *, const int *, int *);
|
||||
void RELAPACK_dpbtrf(const char *, const int *, const int *, double *, const int *, int *);
|
||||
void RELAPACK_cpbtrf(const char *, const int *, const int *, float *, const int *, int *);
|
||||
void RELAPACK_zpbtrf(const char *, const int *, const int *, double *, const int *, int *);
|
||||
void RELAPACK_spotrf(const char *, const blasint *, float *, const blasint *, blasint *);
|
||||
void RELAPACK_dpotrf(const char *, const blasint *, double *, const blasint *, blasint *);
|
||||
void RELAPACK_cpotrf(const char *, const blasint *, float *, const blasint *, blasint *);
|
||||
void RELAPACK_zpotrf(const char *, const blasint *, double *, const blasint *, blasint *);
|
||||
|
||||
void RELAPACK_ssytrf(const char *, const int *, float *, const int *, int *, float *, const int *, int *);
|
||||
void RELAPACK_dsytrf(const char *, const int *, double *, const int *, int *, double *, const int *, int *);
|
||||
void RELAPACK_csytrf(const char *, const int *, float *, const int *, int *, float *, const int *, int *);
|
||||
void RELAPACK_chetrf(const char *, const int *, float *, const int *, int *, float *, const int *, int *);
|
||||
void RELAPACK_zsytrf(const char *, const int *, double *, const int *, int *, double *, const int *, int *);
|
||||
void RELAPACK_zhetrf(const char *, const int *, double *, const int *, int *, double *, const int *, int *);
|
||||
void RELAPACK_ssytrf_rook(const char *, const int *, float *, const int *, int *, float *, const int *, int *);
|
||||
void RELAPACK_dsytrf_rook(const char *, const int *, double *, const int *, int *, double *, const int *, int *);
|
||||
void RELAPACK_csytrf_rook(const char *, const int *, float *, const int *, int *, float *, const int *, int *);
|
||||
void RELAPACK_chetrf_rook(const char *, const int *, float *, const int *, int *, float *, const int *, int *);
|
||||
void RELAPACK_zsytrf_rook(const char *, const int *, double *, const int *, int *, double *, const int *, int *);
|
||||
void RELAPACK_zhetrf_rook(const char *, const int *, double *, const int *, int *, double *, const int *, int *);
|
||||
void RELAPACK_spbtrf(const char *, const blasint *, const blasint *, float *, const blasint *, blasint *);
|
||||
void RELAPACK_dpbtrf(const char *, const blasint *, const blasint *, double *, const blasint *, blasint *);
|
||||
void RELAPACK_cpbtrf(const char *, const blasint *, const blasint *, float *, const blasint *, blasint *);
|
||||
void RELAPACK_zpbtrf(const char *, const blasint *, const blasint *, double *, const blasint *, blasint *);
|
||||
|
||||
void RELAPACK_sgetrf(const int *, const int *, float *, const int *, int *, int *);
|
||||
void RELAPACK_dgetrf(const int *, const int *, double *, const int *, int *, int *);
|
||||
void RELAPACK_cgetrf(const int *, const int *, float *, const int *, int *, int *);
|
||||
void RELAPACK_zgetrf(const int *, const int *, double *, const int *, int *, int *);
|
||||
void RELAPACK_ssytrf(const char *, const blasint *, float *, const blasint *, blasint *, float *, const blasint *, blasint *);
|
||||
void RELAPACK_dsytrf(const char *, const blasint *, double *, const blasint *, blasint *, double *, const blasint *, blasint *);
|
||||
void RELAPACK_csytrf(const char *, const blasint *, float *, const blasint *, blasint *, float *, const blasint *, blasint *);
|
||||
void RELAPACK_chetrf(const char *, const blasint *, float *, const blasint *, blasint *, float *, const blasint *, blasint *);
|
||||
void RELAPACK_zsytrf(const char *, const blasint *, double *, const blasint *, blasint *, double *, const blasint *, blasint *);
|
||||
void RELAPACK_zhetrf(const char *, const blasint *, double *, const blasint *, blasint *, double *, const blasint *, blasint *);
|
||||
void RELAPACK_ssytrf_rook(const char *, const blasint *, float *, const blasint *, blasint *, float *, const blasint *, blasint *);
|
||||
void RELAPACK_dsytrf_rook(const char *, const blasint *, double *, const blasint *, blasint *, double *, const blasint *, blasint *);
|
||||
void RELAPACK_csytrf_rook(const char *, const blasint *, float *, const blasint *, blasint *, float *, const blasint *, blasint *);
|
||||
void RELAPACK_chetrf_rook(const char *, const blasint *, float *, const blasint *, blasint *, float *, const blasint *, blasint *);
|
||||
void RELAPACK_zsytrf_rook(const char *, const blasint *, double *, const blasint *, blasint *, double *, const blasint *, blasint *);
|
||||
void RELAPACK_zhetrf_rook(const char *, const blasint *, double *, const blasint *, blasint *, double *, const blasint *, blasint *);
|
||||
|
||||
void RELAPACK_sgbtrf(const int *, const int *, const int *, const int *, float *, const int *, int *, int *);
|
||||
void RELAPACK_dgbtrf(const int *, const int *, const int *, const int *, double *, const int *, int *, int *);
|
||||
void RELAPACK_cgbtrf(const int *, const int *, const int *, const int *, float *, const int *, int *, int *);
|
||||
void RELAPACK_zgbtrf(const int *, const int *, const int *, const int *, double *, const int *, int *, int *);
|
||||
void RELAPACK_sgetrf(const blasint *, const blasint *, float *, const blasint *, blasint *, blasint *);
|
||||
void RELAPACK_dgetrf(const blasint *, const blasint *, double *, const blasint *, blasint *, blasint *);
|
||||
void RELAPACK_cgetrf(const blasint *, const blasint *, float *, const blasint *, blasint *, blasint *);
|
||||
void RELAPACK_zgetrf(const blasint *, const blasint *, double *, const blasint *, blasint *, blasint *);
|
||||
|
||||
void RELAPACK_ssygst(const int *, const char *, const int *, float *, const int *, const float *, const int *, int *);
|
||||
void RELAPACK_dsygst(const int *, const char *, const int *, double *, const int *, const double *, const int *, int *);
|
||||
void RELAPACK_chegst(const int *, const char *, const int *, float *, const int *, const float *, const int *, int *);
|
||||
void RELAPACK_zhegst(const int *, const char *, const int *, double *, const int *, const double *, const int *, int *);
|
||||
void RELAPACK_sgbtrf(const blasint *, const blasint *, const blasint *, const blasint *, float *, const blasint *, blasint *, blasint *);
|
||||
void RELAPACK_dgbtrf(const blasint *, const blasint *, const blasint *, const blasint *, double *, const blasint *, blasint *, blasint *);
|
||||
void RELAPACK_cgbtrf(const blasint *, const blasint *, const blasint *, const blasint *, float *, const blasint *, blasint *, blasint *);
|
||||
void RELAPACK_zgbtrf(const blasint *, const blasint *, const blasint *, const blasint *, double *, const blasint *, blasint *, blasint *);
|
||||
|
||||
void RELAPACK_strsyl(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(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(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(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_ssygst(const blasint *, const char *, const blasint *, float *, const blasint *, const float *, const blasint *, blasint *);
|
||||
void RELAPACK_dsygst(const blasint *, const char *, const blasint *, double *, const blasint *, const double *, const blasint *, blasint *);
|
||||
void RELAPACK_chegst(const blasint *, const char *, const blasint *, float *, const blasint *, const float *, const blasint *, blasint *);
|
||||
void RELAPACK_zhegst(const blasint *, const char *, const blasint *, double *, const blasint *, const double *, const blasint *, blasint *);
|
||||
|
||||
void RELAPACK_stgsyl(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 *, const int *, int *, int *);
|
||||
void RELAPACK_dtgsyl(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 *, const int *, int *, int *);
|
||||
void RELAPACK_ctgsyl(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 *, const int *, int *, int *);
|
||||
void RELAPACK_ztgsyl(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 *, const int *, int *, int *);
|
||||
void RELAPACK_strsyl(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(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(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(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_sgemmt(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 *);
|
||||
void RELAPACK_dgemmt(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 *);
|
||||
void RELAPACK_cgemmt(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 *);
|
||||
void RELAPACK_zgemmt(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 *);
|
||||
void RELAPACK_stgsyl(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 *, const blasint *, blasint *, blasint *);
|
||||
void RELAPACK_dtgsyl(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 *, const blasint *, blasint *, blasint *);
|
||||
void RELAPACK_ctgsyl(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 *, const blasint *, blasint *, blasint *);
|
||||
void RELAPACK_ztgsyl(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 *, const blasint *, blasint *, blasint *);
|
||||
|
||||
void RELAPACK_sgemmt(const char *, const char *, const char *, const blasint *, const blasint *, const float *, const float *, const blasint *, const float *, const blasint *, const float *, float *, const blasint *);
|
||||
void RELAPACK_dgemmt(const char *, const char *, const char *, const blasint *, const blasint *, const double *, const double *, const blasint *, const double *, const blasint *, const double *, double *, const blasint *);
|
||||
void RELAPACK_cgemmt(const char *, const char *, const char *, const blasint *, const blasint *, const float *, const float *, const blasint *, const float *, const blasint *, const float *, float *, const blasint *);
|
||||
void RELAPACK_zgemmt(const char *, const char *, const char *, const blasint *, const blasint *, const double *, const double *, const blasint *, const double *, const blasint *, const double *, double *, const blasint *);
|
||||
|
||||
#endif /* RELAPACK_H */
|
||||
|
|
|
|||
|
|
@ -1,61 +1,61 @@
|
|||
#ifndef BLAS_H
|
||||
#define BLAS_H
|
||||
|
||||
extern void BLAS(sswap)(const int *, float *, const int *, float *, const int *);
|
||||
extern void BLAS(dswap)(const int *, double *, const int *, double *, const int *);
|
||||
extern void BLAS(cswap)(const int *, float *, const int *, float *, const int *);
|
||||
extern void BLAS(zswap)(const int *, double *, const int *, double *, const int *);
|
||||
extern void BLAS(sswap)(const blasint *, float *, const blasint *, float *, const blasint *);
|
||||
extern void BLAS(dswap)(const blasint *, double *, const blasint *, double *, const blasint *);
|
||||
extern void BLAS(cswap)(const blasint *, float *, const blasint *, float *, const blasint *);
|
||||
extern void BLAS(zswap)(const blasint *, double *, const blasint *, double *, const blasint *);
|
||||
|
||||
extern void BLAS(sscal)(const int *, const float *, float *, const int *);
|
||||
extern void BLAS(dscal)(const int *, const double *, double *, const int *);
|
||||
extern void BLAS(cscal)(const int *, const float *, float *, const int *);
|
||||
extern void BLAS(zscal)(const int *, const double *, double *, const int *);
|
||||
extern void BLAS(sscal)(const blasint *, const float *, float *, const blasint *);
|
||||
extern void BLAS(dscal)(const blasint *, const double *, double *, const blasint *);
|
||||
extern void BLAS(cscal)(const blasint *, const float *, float *, const blasint *);
|
||||
extern void BLAS(zscal)(const blasint *, const double *, double *, const blasint *);
|
||||
|
||||
extern void BLAS(saxpy)(const int *, const float *, const float *, const int *, float *, const int *);
|
||||
extern void BLAS(daxpy)(const int *, const double *, const double *, const int *, double *, const int *);
|
||||
extern void BLAS(caxpy)(const int *, const float *, const float *, const int *, float *, const int *);
|
||||
extern void BLAS(zaxpy)(const int *, const double *, const double *, const int *, double *, const int *);
|
||||
extern void BLAS(saxpy)(const blasint *, const float *, const float *, const blasint *, float *, const blasint *);
|
||||
extern void BLAS(daxpy)(const blasint *, const double *, const double *, const blasint *, double *, const blasint *);
|
||||
extern void BLAS(caxpy)(const blasint *, const float *, const float *, const blasint *, float *, const blasint *);
|
||||
extern void BLAS(zaxpy)(const blasint *, const double *, const double *, const blasint *, double *, const blasint *);
|
||||
|
||||
extern void BLAS(sgemv)(const char *, const int *, const int *, const float *, const float *, const int *, const float *, const int *, const float *, const float *, const int*);
|
||||
extern void BLAS(dgemv)(const char *, const int *, const int *, const double *, const double *, const int *, const double *, const int *, const double *, const double *, const int*);
|
||||
extern void BLAS(cgemv)(const char *, const int *, const int *, const float *, const float *, const int *, const float *, const int *, const float *, const float *, const int*);
|
||||
extern void BLAS(zgemv)(const char *, const int *, const int *, const double *, const double *, const int *, const double *, const int *, const double *, const double *, const int*);
|
||||
extern void BLAS(sgemv)(const char *, const blasint *, const blasint *, const float *, const float *, const blasint *, const float *, const blasint *, const float *, const float *, const blasint*);
|
||||
extern void BLAS(dgemv)(const char *, const blasint *, const blasint *, const double *, const double *, const blasint *, const double *, const blasint *, const double *, const double *, const blasint*);
|
||||
extern void BLAS(cgemv)(const char *, const blasint *, const blasint *, const float *, const float *, const blasint *, const float *, const blasint *, const float *, const float *, const blasint*);
|
||||
extern void BLAS(zgemv)(const char *, const blasint *, const blasint *, const double *, const double *, const blasint *, const double *, const blasint *, const double *, const double *, const blasint*);
|
||||
|
||||
extern void BLAS(sgemm)(const char *, const char *, const int *, const int *, const int *, const float *, const float *, const int *, const float *, const int *, const float *, const float *, const int*);
|
||||
extern void BLAS(dgemm)(const char *, const char *, const int *, const int *, const int *, const double *, const double *, const int *, const double *, const int *, const double *, const double *, const int*);
|
||||
extern void BLAS(cgemm)(const char *, const char *, const int *, const int *, const int *, const float *, const float *, const int *, const float *, const int *, const float *, const float *, const int*);
|
||||
extern void BLAS(zgemm)(const char *, const char *, const int *, const int *, const int *, const double *, const double *, const int *, const double *, const int *, const double *, const double *, const int*);
|
||||
extern void BLAS(sgemm)(const char *, const char *, const blasint *, const blasint *, const blasint *, const float *, const float *, const blasint *, const float *, const blasint *, const float *, const float *, const blasint*);
|
||||
extern void BLAS(dgemm)(const char *, const char *, const blasint *, const blasint *, const blasint *, const double *, const double *, const blasint *, const double *, const blasint *, const double *, const double *, const blasint*);
|
||||
extern void BLAS(cgemm)(const char *, const char *, const blasint *, const blasint *, const blasint *, const float *, const float *, const blasint *, const float *, const blasint *, const float *, const float *, const blasint*);
|
||||
extern void BLAS(zgemm)(const char *, const char *, const blasint *, const blasint *, const blasint *, const double *, const double *, const blasint *, const double *, const blasint *, const double *, const double *, const blasint*);
|
||||
|
||||
extern void BLAS(strsm)(const char *, const char *, const char *, const char *, const int *, const int *, const float *, const float *, const int *, float *, const int *);
|
||||
extern void BLAS(dtrsm)(const char *, const char *, const char *, const char *, const int *, const int *, const double *, const double *, const int *, double *, const int *);
|
||||
extern void BLAS(ctrsm)(const char *, const char *, const char *, const char *, const int *, const int *, const float *, const float *, const int *, float *, const int *);
|
||||
extern void BLAS(ztrsm)(const char *, const char *, const char *, const char *, const int *, const int *, const double *, const double *, const int *, double *, const int *);
|
||||
extern void BLAS(strsm)(const char *, const char *, const char *, const char *, const blasint *, const blasint *, const float *, const float *, const blasint *, float *, const blasint *);
|
||||
extern void BLAS(dtrsm)(const char *, const char *, const char *, const char *, const blasint *, const blasint *, const double *, const double *, const blasint *, double *, const blasint *);
|
||||
extern void BLAS(ctrsm)(const char *, const char *, const char *, const char *, const blasint *, const blasint *, const float *, const float *, const blasint *, float *, const blasint *);
|
||||
extern void BLAS(ztrsm)(const char *, const char *, const char *, const char *, const blasint *, const blasint *, const double *, const double *, const blasint *, double *, const blasint *);
|
||||
|
||||
extern void BLAS(strmm)(const char *, const char *, const char *, const char *, const int *, const int *, const float *, const float *, const int *, float *, const int *);
|
||||
extern void BLAS(dtrmm)(const char *, const char *, const char *, const char *, const int *, const int *, const double *, const double *, const int *, double *, const int *);
|
||||
extern void BLAS(ctrmm)(const char *, const char *, const char *, const char *, const int *, const int *, const float *, const float *, const int *, float *, const int *);
|
||||
extern void BLAS(ztrmm)(const char *, const char *, const char *, const char *, const int *, const int *, const double *, const double *, const int *, double *, const int *);
|
||||
extern void BLAS(strmm)(const char *, const char *, const char *, const char *, const blasint *, const blasint *, const float *, const float *, const blasint *, float *, const blasint *);
|
||||
extern void BLAS(dtrmm)(const char *, const char *, const char *, const char *, const blasint *, const blasint *, const double *, const double *, const blasint *, double *, const blasint *);
|
||||
extern void BLAS(ctrmm)(const char *, const char *, const char *, const char *, const blasint *, const blasint *, const float *, const float *, const blasint *, float *, const blasint *);
|
||||
extern void BLAS(ztrmm)(const char *, const char *, const char *, const char *, const blasint *, const blasint *, const double *, const double *, const blasint *, double *, const blasint *);
|
||||
|
||||
extern void BLAS(ssyrk)(const char *, const char *, const int *, const int *, const float *, float *, const int *, const float *, float *, const int *);
|
||||
extern void BLAS(dsyrk)(const char *, const char *, const int *, const int *, const double *, double *, const int *, const double *, double *, const int *);
|
||||
extern void BLAS(cherk)(const char *, const char *, const int *, const int *, const float *, float *, const int *, const float *, float *, const int *);
|
||||
extern void BLAS(zherk)(const char *, const char *, const int *, const int *, const double *, double *, const int *, const double *, double *, const int *);
|
||||
extern void BLAS(ssyrk)(const char *, const char *, const blasint *, const blasint *, const float *, float *, const blasint *, const float *, float *, const blasint *);
|
||||
extern void BLAS(dsyrk)(const char *, const char *, const blasint *, const blasint *, const double *, double *, const blasint *, const double *, double *, const blasint *);
|
||||
extern void BLAS(cherk)(const char *, const char *, const blasint *, const blasint *, const float *, float *, const blasint *, const float *, float *, const blasint *);
|
||||
extern void BLAS(zherk)(const char *, const char *, const blasint *, const blasint *, const double *, double *, const blasint *, const double *, double *, const blasint *);
|
||||
|
||||
extern void BLAS(ssymm)(const char *, const char *, const int *, const int *, const float *, const float *, const int *, const float *, const int *, const float *, float *, const int *);
|
||||
extern void BLAS(dsymm)(const char *, const char *, const int *, const int *, const double *, const double *, const int *, const double *, const int *, const double *, double *, const int *);
|
||||
extern void BLAS(chemm)(const char *, const char *, const int *, const int *, const float *, const float *, const int *, const float *, const int *, const float *, float *, const int *);
|
||||
extern void BLAS(zhemm)(const char *, const char *, const int *, const int *, const double *, const double *, const int *, const double *, const int *, const double *, double *, const int *);
|
||||
extern void BLAS(ssymm)(const char *, const char *, const blasint *, const blasint *, const float *, const float *, const blasint *, const float *, const blasint *, const float *, float *, const blasint *);
|
||||
extern void BLAS(dsymm)(const char *, const char *, const blasint *, const blasint *, const double *, const double *, const blasint *, const double *, const blasint *, const double *, double *, const blasint *);
|
||||
extern void BLAS(chemm)(const char *, const char *, const blasint *, const blasint *, const float *, const float *, const blasint *, const float *, const blasint *, const float *, float *, const blasint *);
|
||||
extern void BLAS(zhemm)(const char *, const char *, const blasint *, const blasint *, const double *, const double *, const blasint *, const double *, const blasint *, const double *, double *, const blasint *);
|
||||
|
||||
extern void BLAS(ssyr2k)(const char *, const char *, const int *, const int *, const float *, const float *, const int *, const float *, const int *, const float *, float *, const int *);
|
||||
extern void BLAS(dsyr2k)(const char *, const char *, const int *, const int *, const double *, const double *, const int *, const double *, const int *, const double *, double *, const int *);
|
||||
extern void BLAS(cher2k)(const char *, const char *, const int *, const int *, const float *, const float *, const int *, const float *, const int *, const float *, float *, const int *);
|
||||
extern void BLAS(zher2k)(const char *, const char *, const int *, const int *, const double *, const double *, const int *, const double *, const int *, const double *, double *, const int *);
|
||||
extern void BLAS(ssyr2k)(const char *, const char *, const blasint *, const blasint *, const float *, const float *, const blasint *, const float *, const blasint *, const float *, float *, const blasint *);
|
||||
extern void BLAS(dsyr2k)(const char *, const char *, const blasint *, const blasint *, const double *, const double *, const blasint *, const double *, const blasint *, const double *, double *, const blasint *);
|
||||
extern void BLAS(cher2k)(const char *, const char *, const blasint *, const blasint *, const float *, const float *, const blasint *, const float *, const blasint *, const float *, float *, const blasint *);
|
||||
extern void BLAS(zher2k)(const char *, const char *, const blasint *, const blasint *, const double *, const double *, const blasint *, const double *, const blasint *, const double *, double *, const blasint *);
|
||||
|
||||
#if HAVE_XGEMMT
|
||||
extern void BLAS(sgemmt)(const char *, const char *, const char *, const int *, const int *, const float *, const float *, const int *, const float *, const int *, const float *, const float *, const int*);
|
||||
extern void BLAS(dgemmt)(const char *, const char *, const char *, const int *, const int *, const double *, const double *, const int *, const double *, const int *, const double *, const double *, const int*);
|
||||
extern void BLAS(cgemmt)(const char *, const char *, const char *, const int *, const int *, const float *, const float *, const int *, const float *, const int *, const float *, const float *, const int*);
|
||||
extern void BLAS(zgemmt)(const char *, const char *, const char *, const int *, const int *, const double *, const double *, const int *, const double *, const int *, const double *, const double *, const int*);
|
||||
extern void BLAS(sgemmt)(const char *, const char *, const char *, const blasint *, const blasint *, const float *, const float *, const blasint *, const float *, const blasint *, const float *, const float *, const blasint*);
|
||||
extern void BLAS(dgemmt)(const char *, const char *, const char *, const blasint *, const blasint *, const double *, const double *, const blasint *, const double *, const blasint *, const double *, const double *, const blasint*);
|
||||
extern void BLAS(cgemmt)(const char *, const char *, const char *, const blasint *, const blasint *, const float *, const float *, const blasint *, const float *, const blasint *, const float *, const float *, const blasint*);
|
||||
extern void BLAS(zgemmt)(const char *, const char *, const char *, const blasint *, const blasint *, const double *, const double *, const blasint *, const double *, const blasint *, const double *, const double *, const blasint*);
|
||||
#endif
|
||||
|
||||
#endif /* BLAS_H */
|
||||
|
|
|
|||
|
|
@ -1,9 +1,9 @@
|
|||
#include "relapack.h"
|
||||
#include "stdlib.h"
|
||||
|
||||
static void RELAPACK_cgbtrf_rec(const int *, const int *, const int *,
|
||||
const int *, float *, const int *, int *, float *, const int *, float *,
|
||||
const int *, int *);
|
||||
static void RELAPACK_cgbtrf_rec(const blasint *, const blasint *, const blasint *,
|
||||
const blasint *, float *, const blasint *, blasint *, float *, const blasint *, float *,
|
||||
const blasint *, blasint *);
|
||||
|
||||
|
||||
/** CGBTRF computes an LU factorization of a complex m-by-n band matrix A using partial pivoting with row interchanges.
|
||||
|
|
@ -13,9 +13,9 @@ static void RELAPACK_cgbtrf_rec(const int *, const int *, const int *,
|
|||
* http://www.netlib.org/lapack/explore-html/d0/d3a/cgbtrf_8f.html
|
||||
* */
|
||||
void RELAPACK_cgbtrf(
|
||||
const int *m, const int *n, const int *kl, const int *ku,
|
||||
float *Ab, const int *ldAb, int *ipiv,
|
||||
int *info
|
||||
const blasint *m, const blasint *n, const blasint *kl, const blasint *ku,
|
||||
float *Ab, const blasint *ldAb, blasint *ipiv,
|
||||
blasint *info
|
||||
) {
|
||||
|
||||
// Check arguments
|
||||
|
|
@ -31,8 +31,8 @@ void RELAPACK_cgbtrf(
|
|||
else if (*ldAb < 2 * *kl + *ku + 1)
|
||||
*info = -6;
|
||||
if (*info) {
|
||||
const int minfo = -*info;
|
||||
LAPACK(xerbla)("CGBTRF", &minfo);
|
||||
const blasint minfo = -*info;
|
||||
LAPACK(xerbla)("CGBTRF", &minfo, strlen("CGBTRF"));
|
||||
return;
|
||||
}
|
||||
|
||||
|
|
@ -40,14 +40,14 @@ void RELAPACK_cgbtrf(
|
|||
const float ZERO[] = { 0., 0. };
|
||||
|
||||
// Result upper band width
|
||||
const int kv = *ku + *kl;
|
||||
const blasint kv = *ku + *kl;
|
||||
|
||||
// Unskew A
|
||||
const int ldA[] = { *ldAb - 1 };
|
||||
const blasint ldA[] = { *ldAb - 1 };
|
||||
float *const A = Ab + 2 * kv;
|
||||
|
||||
// Zero upper diagonal fill-in elements
|
||||
int i, j;
|
||||
blasint i, j;
|
||||
for (j = 0; j < *n; j++) {
|
||||
float *const A_j = A + 2 * *ldA * j;
|
||||
for (i = MAX(0, j - kv); i < j - *ku; i++)
|
||||
|
|
@ -55,11 +55,11 @@ void RELAPACK_cgbtrf(
|
|||
}
|
||||
|
||||
// Allocate work space
|
||||
const int n1 = CREC_SPLIT(*n);
|
||||
const int mWorkl = (kv > n1) ? MAX(1, *m - *kl) : kv;
|
||||
const int nWorkl = (kv > n1) ? n1 : kv;
|
||||
const int mWorku = (*kl > n1) ? n1 : *kl;
|
||||
const int nWorku = (*kl > n1) ? MAX(0, *n - *kl) : *kl;
|
||||
const blasint n1 = CREC_SPLIT(*n);
|
||||
const blasint mWorkl = (kv > n1) ? MAX(1, *m - *kl) : kv;
|
||||
const blasint nWorkl = (kv > n1) ? n1 : kv;
|
||||
const blasint mWorku = (*kl > n1) ? n1 : *kl;
|
||||
const blasint nWorku = (*kl > n1) ? MAX(0, *n - *kl) : *kl;
|
||||
float *Workl = malloc(mWorkl * nWorkl * 2 * sizeof(float));
|
||||
float *Worku = malloc(mWorku * nWorku * 2 * sizeof(float));
|
||||
LAPACK(claset)("L", &mWorkl, &nWorkl, ZERO, ZERO, Workl, &mWorkl);
|
||||
|
|
@ -76,10 +76,10 @@ void RELAPACK_cgbtrf(
|
|||
|
||||
/** cgbtrf's recursive compute kernel */
|
||||
static void RELAPACK_cgbtrf_rec(
|
||||
const int *m, const int *n, const int *kl, const int *ku,
|
||||
float *Ab, const int *ldAb, int *ipiv,
|
||||
float *Workl, const int *ldWorkl, float *Worku, const int *ldWorku,
|
||||
int *info
|
||||
const blasint *m, const blasint *n, const blasint *kl, const blasint *ku,
|
||||
float *Ab, const blasint *ldAb, blasint *ipiv,
|
||||
float *Workl, const blasint *ldWorkl, float *Worku, const blasint *ldWorku,
|
||||
blasint *info
|
||||
) {
|
||||
|
||||
if (*n <= MAX(CROSSOVER_CGBTRF, 1)) {
|
||||
|
|
@ -91,25 +91,25 @@ static void RELAPACK_cgbtrf_rec(
|
|||
// Constants
|
||||
const float ONE[] = { 1., 0. };
|
||||
const float MONE[] = { -1., 0. };
|
||||
const int iONE[] = { 1 };
|
||||
const blasint iONE[] = { 1 };
|
||||
|
||||
// Loop iterators
|
||||
int i, j;
|
||||
blasint i, j;
|
||||
|
||||
// Output upper band width
|
||||
const int kv = *ku + *kl;
|
||||
const blasint kv = *ku + *kl;
|
||||
|
||||
// Unskew A
|
||||
const int ldA[] = { *ldAb - 1 };
|
||||
const blasint ldA[] = { *ldAb - 1 };
|
||||
float *const A = Ab + 2 * kv;
|
||||
|
||||
// Splitting
|
||||
const int n1 = MIN(CREC_SPLIT(*n), *kl);
|
||||
const int n2 = *n - n1;
|
||||
const int m1 = MIN(n1, *m);
|
||||
const int m2 = *m - m1;
|
||||
const int mn1 = MIN(m1, n1);
|
||||
const int mn2 = MIN(m2, n2);
|
||||
const blasint n1 = MIN(CREC_SPLIT(*n), *kl);
|
||||
const blasint n2 = *n - n1;
|
||||
const blasint m1 = MIN(n1, *m);
|
||||
const blasint m2 = *m - m1;
|
||||
const blasint mn1 = MIN(m1, n1);
|
||||
const blasint mn2 = MIN(m2, n2);
|
||||
|
||||
// Ab_L *
|
||||
// Ab_BR
|
||||
|
|
@ -129,14 +129,14 @@ static void RELAPACK_cgbtrf_rec(
|
|||
|
||||
// ipiv_T
|
||||
// ipiv_B
|
||||
int *const ipiv_T = ipiv;
|
||||
int *const ipiv_B = ipiv + n1;
|
||||
blasint *const ipiv_T = ipiv;
|
||||
blasint *const ipiv_B = ipiv + n1;
|
||||
|
||||
// Banded splitting
|
||||
const int n21 = MIN(n2, kv - n1);
|
||||
const int n22 = MIN(n2 - n21, n1);
|
||||
const int m21 = MIN(m2, *kl - m1);
|
||||
const int m22 = MIN(m2 - m21, m1);
|
||||
const blasint n21 = MIN(n2, kv - n1);
|
||||
const blasint n22 = MIN(n2 - n21, n1);
|
||||
const blasint m21 = MIN(m2, *kl - m1);
|
||||
const blasint m22 = MIN(m2 - m21, m1);
|
||||
|
||||
// n1 n21 n22
|
||||
// m * A_Rl ARr
|
||||
|
|
@ -164,7 +164,7 @@ static void RELAPACK_cgbtrf_rec(
|
|||
|
||||
// partially redo swaps in A_L
|
||||
for (i = 0; i < mn1; i++) {
|
||||
const int ip = ipiv_T[i] - 1;
|
||||
const blasint ip = ipiv_T[i] - 1;
|
||||
if (ip != i) {
|
||||
if (ip < *kl)
|
||||
BLAS(cswap)(&i, A_L + 2 * i, ldA, A_L + 2 * ip, ldA);
|
||||
|
|
@ -180,7 +180,7 @@ static void RELAPACK_cgbtrf_rec(
|
|||
for (j = 0; j < n22; j++) {
|
||||
float *const A_Rrj = A_Rr + 2 * *ldA * j;
|
||||
for (i = j; i < mn1; i++) {
|
||||
const int ip = ipiv_T[i] - 1;
|
||||
const blasint ip = ipiv_T[i] - 1;
|
||||
if (ip != i) {
|
||||
const float tmpr = A_Rrj[2 * i];
|
||||
const float tmpc = A_Rrj[2 * i + 1];
|
||||
|
|
@ -211,7 +211,7 @@ static void RELAPACK_cgbtrf_rec(
|
|||
|
||||
// partially undo swaps in A_L
|
||||
for (i = mn1 - 1; i >= 0; i--) {
|
||||
const int ip = ipiv_T[i] - 1;
|
||||
const blasint ip = ipiv_T[i] - 1;
|
||||
if (ip != i) {
|
||||
if (ip < *kl)
|
||||
BLAS(cswap)(&i, A_L + 2 * i, ldA, A_L + 2 * ip, ldA);
|
||||
|
|
|
|||
|
|
@ -1,12 +1,12 @@
|
|||
#include "relapack.h"
|
||||
|
||||
static void RELAPACK_cgemmt_rec(const char *, const char *, const char *,
|
||||
const int *, const int *, const float *, const float *, const int *,
|
||||
const float *, const int *, const float *, float *, const int *);
|
||||
const blasint *, const blasint *, const float *, const float *, const blasint *,
|
||||
const float *, const blasint *, const float *, float *, const blasint *);
|
||||
|
||||
static void RELAPACK_cgemmt_rec2(const char *, const char *, const char *,
|
||||
const int *, const int *, const float *, const float *, const int *,
|
||||
const float *, const int *, const float *, float *, const int *);
|
||||
const blasint *, const blasint *, const float *, const float *, const blasint *,
|
||||
const float *, const blasint *, const float *, float *, const blasint *);
|
||||
|
||||
|
||||
/** CGEMMT computes a matrix-matrix product with general matrices but updates
|
||||
|
|
@ -20,10 +20,10 @@ static void RELAPACK_cgemmt_rec2(const char *, const char *, const char *,
|
|||
* */
|
||||
void RELAPACK_cgemmt(
|
||||
const char *uplo, const char *transA, const char *transB,
|
||||
const int *n, const int *k,
|
||||
const float *alpha, const float *A, const int *ldA,
|
||||
const float *B, const int *ldB,
|
||||
const float *beta, float *C, const int *ldC
|
||||
const blasint *n, const blasint *k,
|
||||
const float *alpha, const float *A, const blasint *ldA,
|
||||
const float *B, const blasint *ldB,
|
||||
const float *beta, float *C, const blasint *ldC
|
||||
) {
|
||||
|
||||
#if HAVE_XGEMMT
|
||||
|
|
@ -32,15 +32,15 @@ void RELAPACK_cgemmt(
|
|||
#else
|
||||
|
||||
// Check arguments
|
||||
const int lower = LAPACK(lsame)(uplo, "L");
|
||||
const int upper = LAPACK(lsame)(uplo, "U");
|
||||
const int notransA = LAPACK(lsame)(transA, "N");
|
||||
const int tranA = LAPACK(lsame)(transA, "T");
|
||||
const int ctransA = LAPACK(lsame)(transA, "C");
|
||||
const int notransB = LAPACK(lsame)(transB, "N");
|
||||
const int tranB = LAPACK(lsame)(transB, "T");
|
||||
const int ctransB = LAPACK(lsame)(transB, "C");
|
||||
int info = 0;
|
||||
const blasint lower = LAPACK(lsame)(uplo, "L");
|
||||
const blasint upper = LAPACK(lsame)(uplo, "U");
|
||||
const blasint notransA = LAPACK(lsame)(transA, "N");
|
||||
const blasint tranA = LAPACK(lsame)(transA, "T");
|
||||
const blasint ctransA = LAPACK(lsame)(transA, "C");
|
||||
const blasint notransB = LAPACK(lsame)(transB, "N");
|
||||
const blasint tranB = LAPACK(lsame)(transB, "T");
|
||||
const blasint ctransB = LAPACK(lsame)(transB, "C");
|
||||
blasint info = 0;
|
||||
if (!lower && !upper)
|
||||
info = 1;
|
||||
else if (!tranA && !ctransA && !notransA)
|
||||
|
|
@ -58,7 +58,7 @@ void RELAPACK_cgemmt(
|
|||
else if (*ldC < MAX(1, *n))
|
||||
info = 13;
|
||||
if (info) {
|
||||
LAPACK(xerbla)("CGEMMT", &info);
|
||||
LAPACK(xerbla)("CGEMMT", &info, strlen("CGEMMT"));
|
||||
return;
|
||||
}
|
||||
|
||||
|
|
@ -76,10 +76,10 @@ void RELAPACK_cgemmt(
|
|||
/** cgemmt's recursive compute kernel */
|
||||
static void RELAPACK_cgemmt_rec(
|
||||
const char *uplo, const char *transA, const char *transB,
|
||||
const int *n, const int *k,
|
||||
const float *alpha, const float *A, const int *ldA,
|
||||
const float *B, const int *ldB,
|
||||
const float *beta, float *C, const int *ldC
|
||||
const blasint *n, const blasint *k,
|
||||
const float *alpha, const float *A, const blasint *ldA,
|
||||
const float *B, const blasint *ldB,
|
||||
const float *beta, float *C, const blasint *ldC
|
||||
) {
|
||||
|
||||
if (*n <= MAX(CROSSOVER_CGEMMT, 1)) {
|
||||
|
|
@ -89,8 +89,8 @@ static void RELAPACK_cgemmt_rec(
|
|||
}
|
||||
|
||||
// Splitting
|
||||
const int n1 = CREC_SPLIT(*n);
|
||||
const int n2 = *n - n1;
|
||||
const blasint n1 = CREC_SPLIT(*n);
|
||||
const blasint n2 = *n - n1;
|
||||
|
||||
// A_T
|
||||
// A_B
|
||||
|
|
@ -126,16 +126,16 @@ static void RELAPACK_cgemmt_rec(
|
|||
/** cgemmt's unblocked compute kernel */
|
||||
static void RELAPACK_cgemmt_rec2(
|
||||
const char *uplo, const char *transA, const char *transB,
|
||||
const int *n, const int *k,
|
||||
const float *alpha, const float *A, const int *ldA,
|
||||
const float *B, const int *ldB,
|
||||
const float *beta, float *C, const int *ldC
|
||||
const blasint *n, const blasint *k,
|
||||
const float *alpha, const float *A, const blasint *ldA,
|
||||
const float *B, const blasint *ldB,
|
||||
const float *beta, float *C, const blasint *ldC
|
||||
) {
|
||||
|
||||
const int incB = (*transB == 'N') ? 1 : *ldB;
|
||||
const int incC = 1;
|
||||
const blasint incB = (*transB == 'N') ? 1 : *ldB;
|
||||
const blasint incC = 1;
|
||||
|
||||
int i;
|
||||
blasint i;
|
||||
for (i = 0; i < *n; i++) {
|
||||
// A_0
|
||||
// A_i
|
||||
|
|
@ -151,13 +151,13 @@ static void RELAPACK_cgemmt_rec2(
|
|||
float *const C_ii = C + 2 * *ldC * i + 2 * i;
|
||||
|
||||
if (*uplo == 'L') {
|
||||
const int nmi = *n - i;
|
||||
const blasint nmi = *n - i;
|
||||
if (*transA == 'N')
|
||||
BLAS(cgemv)(transA, &nmi, k, alpha, A_i, ldA, B_i, &incB, beta, C_ii, &incC);
|
||||
else
|
||||
BLAS(cgemv)(transA, k, &nmi, alpha, A_i, ldA, B_i, &incB, beta, C_ii, &incC);
|
||||
} else {
|
||||
const int ip1 = i + 1;
|
||||
const blasint ip1 = i + 1;
|
||||
if (*transA == 'N')
|
||||
BLAS(cgemv)(transA, &ip1, k, alpha, A_0, ldA, B_i, &incB, beta, C_0i, &incC);
|
||||
else
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
#include "relapack.h"
|
||||
|
||||
static void RELAPACK_cgetrf_rec(const int *, const int *, float *,
|
||||
const int *, int *, int *);
|
||||
static void RELAPACK_cgetrf_rec(const blasint *, const blasint *, float *,
|
||||
const blasint *, blasint *, blasint *);
|
||||
|
||||
|
||||
/** CGETRF computes an LU factorization of a general M-by-N matrix A using partial pivoting with row interchanges.
|
||||
|
|
@ -11,9 +11,9 @@ static void RELAPACK_cgetrf_rec(const int *, const int *, float *,
|
|||
* http://www.netlib.org/lapack/explore-html/d9/dfb/cgetrf_8f.html
|
||||
*/
|
||||
void RELAPACK_cgetrf(
|
||||
const int *m, const int *n,
|
||||
float *A, const int *ldA, int *ipiv,
|
||||
int *info
|
||||
const blasint *m, const blasint *n,
|
||||
float *A, const blasint *ldA, blasint *ipiv,
|
||||
blasint *info
|
||||
) {
|
||||
|
||||
// Check arguments
|
||||
|
|
@ -25,12 +25,12 @@ void RELAPACK_cgetrf(
|
|||
else if (*ldA < MAX(1, *n))
|
||||
*info = -4;
|
||||
if (*info) {
|
||||
const int minfo = -*info;
|
||||
LAPACK(xerbla)("CGETRF", &minfo);
|
||||
const blasint minfo = -*info;
|
||||
LAPACK(xerbla)("CGETRF", &minfo, strlen("CGETRF"));
|
||||
return;
|
||||
}
|
||||
|
||||
const int sn = MIN(*m, *n);
|
||||
const blasint sn = MIN(*m, *n);
|
||||
|
||||
RELAPACK_cgetrf_rec(m, &sn, A, ldA, ipiv, info);
|
||||
|
||||
|
|
@ -38,10 +38,10 @@ void RELAPACK_cgetrf(
|
|||
if (*m < *n) {
|
||||
// Constants
|
||||
const float ONE[] = { 1., 0. };
|
||||
const int iONE[] = { 1 };
|
||||
const blasint iONE[] = { 1 };
|
||||
|
||||
// Splitting
|
||||
const int rn = *n - *m;
|
||||
const blasint rn = *n - *m;
|
||||
|
||||
// A_L A_R
|
||||
const float *const A_L = A;
|
||||
|
|
@ -57,9 +57,9 @@ void RELAPACK_cgetrf(
|
|||
|
||||
/** cgetrf's recursive compute kernel */
|
||||
static void RELAPACK_cgetrf_rec(
|
||||
const int *m, const int *n,
|
||||
float *A, const int *ldA, int *ipiv,
|
||||
int *info
|
||||
const blasint *m, const blasint *n,
|
||||
float *A, const blasint *ldA, blasint *ipiv,
|
||||
blasint *info
|
||||
) {
|
||||
|
||||
if (*n <= MAX(CROSSOVER_CGETRF, 1)) {
|
||||
|
|
@ -71,12 +71,12 @@ static void RELAPACK_cgetrf_rec(
|
|||
// Constants
|
||||
const float ONE[] = { 1., 0. };
|
||||
const float MONE[] = { -1., 0. };
|
||||
const int iONE[] = { 1 };
|
||||
const blasint iONE[] = { 1 };
|
||||
|
||||
// Splitting
|
||||
const int n1 = CREC_SPLIT(*n);
|
||||
const int n2 = *n - n1;
|
||||
const int m2 = *m - n1;
|
||||
const blasint n1 = CREC_SPLIT(*n);
|
||||
const blasint n2 = *n - n1;
|
||||
const blasint m2 = *m - n1;
|
||||
|
||||
// A_L A_R
|
||||
float *const A_L = A;
|
||||
|
|
@ -91,8 +91,8 @@ static void RELAPACK_cgetrf_rec(
|
|||
|
||||
// ipiv_T
|
||||
// ipiv_B
|
||||
int *const ipiv_T = ipiv;
|
||||
int *const ipiv_B = ipiv + n1;
|
||||
blasint *const ipiv_T = ipiv;
|
||||
blasint *const ipiv_B = ipiv + n1;
|
||||
|
||||
// recursion(A_L, ipiv_T)
|
||||
RELAPACK_cgetrf_rec(m, &n1, A_L, ldA, ipiv_T, info);
|
||||
|
|
@ -111,7 +111,7 @@ static void RELAPACK_cgetrf_rec(
|
|||
// apply pivots to A_BL
|
||||
LAPACK(claswp)(&n1, A_BL, ldA, iONE, &n2, ipiv_B, iONE);
|
||||
// shift pivots
|
||||
int i;
|
||||
blasint i;
|
||||
for (i = 0; i < n2; i++)
|
||||
ipiv_B[i] += n1;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -3,9 +3,9 @@
|
|||
#include "stdlib.h"
|
||||
#endif
|
||||
|
||||
static void RELAPACK_chegst_rec(const int *, const char *, const int *,
|
||||
float *, const int *, const float *, const int *,
|
||||
float *, const int *, int *);
|
||||
static void RELAPACK_chegst_rec(const blasint *, const char *, const blasint *,
|
||||
float *, const blasint *, const float *, const blasint *,
|
||||
float *, const blasint *, blasint *);
|
||||
|
||||
|
||||
/** CHEGST reduces a complex Hermitian-definite generalized eigenproblem to standard form.
|
||||
|
|
@ -15,14 +15,14 @@ static void RELAPACK_chegst_rec(const int *, const char *, const int *,
|
|||
* http://www.netlib.org/lapack/explore-html/d7/d2a/chegst_8f.html
|
||||
* */
|
||||
void RELAPACK_chegst(
|
||||
const int *itype, const char *uplo, const int *n,
|
||||
float *A, const int *ldA, const float *B, const int *ldB,
|
||||
int *info
|
||||
const blasint *itype, const char *uplo, const blasint *n,
|
||||
float *A, const blasint *ldA, const float *B, const blasint *ldB,
|
||||
blasint *info
|
||||
) {
|
||||
|
||||
// Check arguments
|
||||
const int lower = LAPACK(lsame)(uplo, "L");
|
||||
const int upper = LAPACK(lsame)(uplo, "U");
|
||||
const blasint lower = LAPACK(lsame)(uplo, "L");
|
||||
const blasint upper = LAPACK(lsame)(uplo, "U");
|
||||
*info = 0;
|
||||
if (*itype < 1 || *itype > 3)
|
||||
*info = -1;
|
||||
|
|
@ -35,8 +35,8 @@ void RELAPACK_chegst(
|
|||
else if (*ldB < MAX(1, *n))
|
||||
*info = -7;
|
||||
if (*info) {
|
||||
const int minfo = -*info;
|
||||
LAPACK(xerbla)("CHEGST", &minfo);
|
||||
const blasint minfo = -*info;
|
||||
LAPACK(xerbla)("CHEGST", &minfo, strlen("CHEGST"));
|
||||
return;
|
||||
}
|
||||
|
||||
|
|
@ -45,9 +45,9 @@ void RELAPACK_chegst(
|
|||
|
||||
// Allocate work space
|
||||
float *Work = NULL;
|
||||
int lWork = 0;
|
||||
blasint lWork = 0;
|
||||
#if XSYGST_ALLOW_MALLOC
|
||||
const int n1 = CREC_SPLIT(*n);
|
||||
const blasint n1 = CREC_SPLIT(*n);
|
||||
lWork = n1 * (*n - n1);
|
||||
Work = malloc(lWork * 2 * sizeof(float));
|
||||
if (!Work)
|
||||
|
|
@ -67,9 +67,9 @@ void RELAPACK_chegst(
|
|||
|
||||
/** chegst's recursive compute kernel */
|
||||
static void RELAPACK_chegst_rec(
|
||||
const int *itype, const char *uplo, const int *n,
|
||||
float *A, const int *ldA, const float *B, const int *ldB,
|
||||
float *Work, const int *lWork, int *info
|
||||
const blasint *itype, const char *uplo, const blasint *n,
|
||||
float *A, const blasint *ldA, const float *B, const blasint *ldB,
|
||||
float *Work, const blasint *lWork, blasint *info
|
||||
) {
|
||||
|
||||
if (*n <= MAX(CROSSOVER_CHEGST, 1)) {
|
||||
|
|
@ -84,14 +84,14 @@ static void RELAPACK_chegst_rec(
|
|||
const float MONE[] = { -1., 0. };
|
||||
const float HALF[] = { .5, 0. };
|
||||
const float MHALF[] = { -.5, 0. };
|
||||
const int iONE[] = { 1 };
|
||||
const blasint iONE[] = { 1 };
|
||||
|
||||
// Loop iterator
|
||||
int i;
|
||||
blasint i;
|
||||
|
||||
// Splitting
|
||||
const int n1 = CREC_SPLIT(*n);
|
||||
const int n2 = *n - n1;
|
||||
const blasint n1 = CREC_SPLIT(*n);
|
||||
const blasint n2 = *n - n1;
|
||||
|
||||
// A_TL A_TR
|
||||
// A_BL A_BR
|
||||
|
|
|
|||
|
|
@ -3,8 +3,8 @@
|
|||
#include <stdlib.h>
|
||||
#endif
|
||||
|
||||
static void RELAPACK_chetrf_rec(const char *, const int *, const int *, int *,
|
||||
float *, const int *, int *, float *, const int *, int *);
|
||||
static void RELAPACK_chetrf_rec(const char *, const blasint *, const blasint *, blasint *,
|
||||
float *, const blasint *, blasint *, float *, const blasint *, blasint *);
|
||||
|
||||
|
||||
/** CHETRF computes the factorization of a complex Hermitian matrix A using the Bunch-Kaufman diagonal pivoting method.
|
||||
|
|
@ -14,21 +14,21 @@ static void RELAPACK_chetrf_rec(const char *, const int *, const int *, int *,
|
|||
* http://www.netlib.org/lapack/explore-html/da/dc1/chetrf_8f.html
|
||||
* */
|
||||
void RELAPACK_chetrf(
|
||||
const char *uplo, const int *n,
|
||||
float *A, const int *ldA, int *ipiv,
|
||||
float *Work, const int *lWork, int *info
|
||||
const char *uplo, const blasint *n,
|
||||
float *A, const blasint *ldA, blasint *ipiv,
|
||||
float *Work, const blasint *lWork, blasint *info
|
||||
) {
|
||||
|
||||
// Required work size
|
||||
const int cleanlWork = *n * (*n / 2);
|
||||
int minlWork = cleanlWork;
|
||||
const blasint cleanlWork = *n * (*n / 2);
|
||||
blasint minlWork = cleanlWork;
|
||||
#if XSYTRF_ALLOW_MALLOC
|
||||
minlWork = 1;
|
||||
#endif
|
||||
|
||||
// Check arguments
|
||||
const int lower = LAPACK(lsame)(uplo, "L");
|
||||
const int upper = LAPACK(lsame)(uplo, "U");
|
||||
const blasint lower = LAPACK(lsame)(uplo, "L");
|
||||
const blasint upper = LAPACK(lsame)(uplo, "U");
|
||||
*info = 0;
|
||||
if (!lower && !upper)
|
||||
*info = -1;
|
||||
|
|
@ -55,8 +55,8 @@ void RELAPACK_chetrf(
|
|||
#endif
|
||||
|
||||
if (*info) {
|
||||
const int minfo = -*info;
|
||||
LAPACK(xerbla)("CHETRF", &minfo);
|
||||
const blasint minfo = -*info;
|
||||
LAPACK(xerbla)("CHETRF", &minfo, strlen("CHETRF"));
|
||||
return;
|
||||
}
|
||||
|
||||
|
|
@ -64,7 +64,7 @@ void RELAPACK_chetrf(
|
|||
const char cleanuplo = lower ? 'L' : 'U';
|
||||
|
||||
// Dummy argument
|
||||
int nout;
|
||||
blasint nout;
|
||||
|
||||
// Recursive kernel
|
||||
RELAPACK_chetrf_rec(&cleanuplo, n, n, &nout, A, ldA, ipiv, cleanWork, n, info);
|
||||
|
|
@ -78,13 +78,13 @@ void RELAPACK_chetrf(
|
|||
|
||||
/** chetrf's recursive compute kernel */
|
||||
static void RELAPACK_chetrf_rec(
|
||||
const char *uplo, const int *n_full, const int *n, int *n_out,
|
||||
float *A, const int *ldA, int *ipiv,
|
||||
float *Work, const int *ldWork, int *info
|
||||
const char *uplo, const blasint *n_full, const blasint *n, blasint *n_out,
|
||||
float *A, const blasint *ldA, blasint *ipiv,
|
||||
float *Work, const blasint *ldWork, blasint *info
|
||||
) {
|
||||
|
||||
// top recursion level?
|
||||
const int top = *n_full == *n;
|
||||
const blasint top = *n_full == *n;
|
||||
|
||||
if (*n <= MAX(CROSSOVER_CHETRF, 3)) {
|
||||
// Unblocked
|
||||
|
|
@ -96,31 +96,31 @@ static void RELAPACK_chetrf_rec(
|
|||
return;
|
||||
}
|
||||
|
||||
int info1, info2;
|
||||
blasint info1, info2;
|
||||
|
||||
// Constants
|
||||
const float ONE[] = { 1., 0. };
|
||||
const float MONE[] = { -1., 0. };
|
||||
const int iONE[] = { 1 };
|
||||
const blasint iONE[] = { 1 };
|
||||
|
||||
const int n_rest = *n_full - *n;
|
||||
const blasint n_rest = *n_full - *n;
|
||||
|
||||
if (*uplo == 'L') {
|
||||
// Splitting (setup)
|
||||
int n1 = CREC_SPLIT(*n);
|
||||
int n2 = *n - n1;
|
||||
blasint n1 = CREC_SPLIT(*n);
|
||||
blasint n2 = *n - n1;
|
||||
|
||||
// Work_L *
|
||||
float *const Work_L = Work;
|
||||
|
||||
// recursion(A_L)
|
||||
int n1_out;
|
||||
blasint n1_out;
|
||||
RELAPACK_chetrf_rec(uplo, n_full, &n1, &n1_out, A, ldA, ipiv, Work_L, ldWork, &info1);
|
||||
n1 = n1_out;
|
||||
|
||||
// Splitting (continued)
|
||||
n2 = *n - n1;
|
||||
const int n_full2 = *n_full - n1;
|
||||
const blasint n_full2 = *n_full - n1;
|
||||
|
||||
// * *
|
||||
// A_BL A_BR
|
||||
|
|
@ -136,23 +136,23 @@ static void RELAPACK_chetrf_rec(
|
|||
// (top recursion level: use Work as Work_BR)
|
||||
float *const Work_BL = Work + 2 * n1;
|
||||
float *const Work_BR = top ? Work : Work + 2 * *ldWork * n1 + 2 * n1;
|
||||
const int ldWork_BR = top ? n2 : *ldWork;
|
||||
const blasint ldWork_BR = top ? n2 : *ldWork;
|
||||
|
||||
// ipiv_T
|
||||
// ipiv_B
|
||||
int *const ipiv_B = ipiv + n1;
|
||||
blasint *const ipiv_B = ipiv + n1;
|
||||
|
||||
// A_BR = A_BR - A_BL Work_BL'
|
||||
RELAPACK_cgemmt(uplo, "N", "T", &n2, &n1, MONE, A_BL, ldA, Work_BL, ldWork, ONE, A_BR, ldA);
|
||||
BLAS(cgemm)("N", "T", &n_rest, &n2, &n1, MONE, A_BL_B, ldA, Work_BL, ldWork, ONE, A_BR_B, ldA);
|
||||
|
||||
// recursion(A_BR)
|
||||
int n2_out;
|
||||
blasint n2_out;
|
||||
RELAPACK_chetrf_rec(uplo, &n_full2, &n2, &n2_out, A_BR, ldA, ipiv_B, Work_BR, &ldWork_BR, &info2);
|
||||
|
||||
if (n2_out != n2) {
|
||||
// undo 1 column of updates
|
||||
const int n_restp1 = n_rest + 1;
|
||||
const blasint n_restp1 = n_rest + 1;
|
||||
|
||||
// last column of A_BR
|
||||
float *const A_BR_r = A_BR + 2 * *ldA * n2_out + 2 * n2_out;
|
||||
|
|
@ -169,7 +169,7 @@ static void RELAPACK_chetrf_rec(
|
|||
n2 = n2_out;
|
||||
|
||||
// shift pivots
|
||||
int i;
|
||||
blasint i;
|
||||
for (i = 0; i < n2; i++)
|
||||
if (ipiv_B[i] > 0)
|
||||
ipiv_B[i] += n1;
|
||||
|
|
@ -180,22 +180,22 @@ static void RELAPACK_chetrf_rec(
|
|||
*n_out = n1 + n2;
|
||||
} else {
|
||||
// Splitting (setup)
|
||||
int n2 = CREC_SPLIT(*n);
|
||||
int n1 = *n - n2;
|
||||
blasint n2 = CREC_SPLIT(*n);
|
||||
blasint n1 = *n - n2;
|
||||
|
||||
// * Work_R
|
||||
// (top recursion level: use Work as Work_R)
|
||||
float *const Work_R = top ? Work : Work + 2 * *ldWork * n1;
|
||||
|
||||
// recursion(A_R)
|
||||
int n2_out;
|
||||
blasint n2_out;
|
||||
RELAPACK_chetrf_rec(uplo, n_full, &n2, &n2_out, A, ldA, ipiv, Work_R, ldWork, &info2);
|
||||
const int n2_diff = n2 - n2_out;
|
||||
const blasint n2_diff = n2 - n2_out;
|
||||
n2 = n2_out;
|
||||
|
||||
// Splitting (continued)
|
||||
n1 = *n - n2;
|
||||
const int n_full1 = *n_full - n2;
|
||||
const blasint n_full1 = *n_full - n2;
|
||||
|
||||
// * A_TL_T A_TR_T
|
||||
// * A_TL A_TR
|
||||
|
|
@ -211,19 +211,19 @@ static void RELAPACK_chetrf_rec(
|
|||
// (top recursion level: Work_R was Work)
|
||||
float *const Work_L = Work;
|
||||
float *const Work_TR = Work + 2 * *ldWork * (top ? n2_diff : n1) + 2 * n_rest;
|
||||
const int ldWork_L = top ? n1 : *ldWork;
|
||||
const blasint ldWork_L = top ? n1 : *ldWork;
|
||||
|
||||
// A_TL = A_TL - A_TR Work_TR'
|
||||
RELAPACK_cgemmt(uplo, "N", "T", &n1, &n2, MONE, A_TR, ldA, Work_TR, ldWork, ONE, A_TL, ldA);
|
||||
BLAS(cgemm)("N", "T", &n_rest, &n1, &n2, MONE, A_TR_T, ldA, Work_TR, ldWork, ONE, A_TL_T, ldA);
|
||||
|
||||
// recursion(A_TL)
|
||||
int n1_out;
|
||||
blasint n1_out;
|
||||
RELAPACK_chetrf_rec(uplo, &n_full1, &n1, &n1_out, A, ldA, ipiv, Work_L, &ldWork_L, &info1);
|
||||
|
||||
if (n1_out != n1) {
|
||||
// undo 1 column of updates
|
||||
const int n_restp1 = n_rest + 1;
|
||||
const blasint n_restp1 = n_rest + 1;
|
||||
|
||||
// A_TL_T_l = A_TL_T_l + A_TR_T Work_TR_t'
|
||||
BLAS(cgemv)("N", &n_restp1, &n2, ONE, A_TR_T, ldA, Work_TR, ldWork, ONE, A_TL_T, iONE);
|
||||
|
|
|
|||
|
|
@ -15,7 +15,7 @@
|
|||
/* Table of constant values */
|
||||
|
||||
static complex c_b1 = {1.f,0.f};
|
||||
static int c__1 = 1;
|
||||
static blasint c__1 = 1;
|
||||
|
||||
/** CHETRF_REC2 computes a partial factorization of a complex Hermitian indefinite matrix using the Bunch-Kau fman diagonal pivoting method
|
||||
*
|
||||
|
|
@ -24,12 +24,12 @@ static int c__1 = 1;
|
|||
* The blocked BLAS Level 3 updates were removed and moved to the
|
||||
* recursive algorithm.
|
||||
* */
|
||||
/* Subroutine */ void RELAPACK_chetrf_rec2(char *uplo, int *n, int *
|
||||
nb, int *kb, complex *a, int *lda, int *ipiv, complex *w,
|
||||
int *ldw, int *info, ftnlen uplo_len)
|
||||
/* Subroutine */ void RELAPACK_chetrf_rec2(char *uplo, blasint *n, blasint *
|
||||
nb, blasint *kb, complex *a, blasint *lda, blasint *ipiv, complex *w,
|
||||
int *ldw, blasint *info, ftnlen uplo_len)
|
||||
{
|
||||
/* System generated locals */
|
||||
int a_dim1, a_offset, w_dim1, w_offset, i__1, i__2, i__3, i__4;
|
||||
blasint a_dim1, a_offset, w_dim1, w_offset, i__1, i__2, i__3, i__4;
|
||||
float r__1, r__2, r__3, r__4;
|
||||
complex q__1, q__2, q__3, q__4;
|
||||
|
||||
|
|
@ -38,22 +38,22 @@ static int c__1 = 1;
|
|||
void r_cnjg(complex *, complex *), c_div(complex *, complex *, complex *);
|
||||
|
||||
/* Local variables */
|
||||
static int j, k;
|
||||
static blasint j, k;
|
||||
static float t, r1;
|
||||
static complex d11, d21, d22;
|
||||
static int jj, kk, jp, kp, kw, kkw, imax, jmax;
|
||||
static blasint jj, kk, jp, kp, kw, kkw, imax, jmax;
|
||||
static float alpha;
|
||||
extern logical lsame_(char *, char *, ftnlen, ftnlen);
|
||||
extern /* Subroutine */ int cgemv_(char *, int *, int *, complex *
|
||||
, complex *, int *, complex *, int *, complex *, complex *
|
||||
, int *, ftnlen), ccopy_(int *, complex *, int *,
|
||||
complex *, int *), cswap_(int *, complex *, int *,
|
||||
complex *, int *);
|
||||
static int kstep;
|
||||
extern /* Subroutine */ blasint cgemv_(char *, blasint *, blasint *, complex *
|
||||
, complex *, blasint *, complex *, blasint *, complex *, complex *
|
||||
, blasint *, ftnlen), ccopy_(int *, complex *, blasint *,
|
||||
complex *, blasint *), cswap_(int *, complex *, blasint *,
|
||||
complex *, blasint *);
|
||||
static blasint kstep;
|
||||
static float absakk;
|
||||
extern /* Subroutine */ int clacgv_(int *, complex *, int *);
|
||||
extern int icamax_(int *, complex *, int *);
|
||||
extern /* Subroutine */ int csscal_(int *, float *, complex *, int
|
||||
extern /* Subroutine */ blasint clacgv_(int *, complex *, blasint *);
|
||||
extern blasint icamax_(int *, complex *, blasint *);
|
||||
extern /* Subroutine */ blasint csscal_(int *, float *, complex *, int
|
||||
*);
|
||||
static float colmax, rowmax;
|
||||
|
||||
|
|
|
|||
|
|
@ -3,8 +3,8 @@
|
|||
#include <stdlib.h>
|
||||
#endif
|
||||
|
||||
static void RELAPACK_chetrf_rook_rec(const char *, const int *, const int *, int *,
|
||||
float *, const int *, int *, float *, const int *, int *);
|
||||
static void RELAPACK_chetrf_rook_rec(const char *, const blasint *, const blasint *, blasint *,
|
||||
float *, const blasint *, blasint *, float *, const blasint *, blasint *);
|
||||
|
||||
|
||||
/** CHETRF_ROOK computes the factorization of a complex Hermitian indefinite matrix using the bounded Bunch-Kaufman ("rook") diagonal pivoting method.
|
||||
|
|
@ -14,21 +14,21 @@ static void RELAPACK_chetrf_rook_rec(const char *, const int *, const int *, int
|
|||
* http://www.netlib.org/lapack/explore-html/d0/d5e/chetrf__rook_8f.html
|
||||
* */
|
||||
void RELAPACK_chetrf_rook(
|
||||
const char *uplo, const int *n,
|
||||
float *A, const int *ldA, int *ipiv,
|
||||
float *Work, const int *lWork, int *info
|
||||
const char *uplo, const blasint *n,
|
||||
float *A, const blasint *ldA, blasint *ipiv,
|
||||
float *Work, const blasint *lWork, blasint *info
|
||||
) {
|
||||
|
||||
// Required work size
|
||||
const int cleanlWork = *n * (*n / 2);
|
||||
int minlWork = cleanlWork;
|
||||
const blasint cleanlWork = *n * (*n / 2);
|
||||
blasint minlWork = cleanlWork;
|
||||
#if XSYTRF_ALLOW_MALLOC
|
||||
minlWork = 1;
|
||||
#endif
|
||||
|
||||
// Check arguments
|
||||
const int lower = LAPACK(lsame)(uplo, "L");
|
||||
const int upper = LAPACK(lsame)(uplo, "U");
|
||||
const blasint lower = LAPACK(lsame)(uplo, "L");
|
||||
const blasint upper = LAPACK(lsame)(uplo, "U");
|
||||
*info = 0;
|
||||
if (!lower && !upper)
|
||||
*info = -1;
|
||||
|
|
@ -55,8 +55,8 @@ void RELAPACK_chetrf_rook(
|
|||
#endif
|
||||
|
||||
if (*info) {
|
||||
const int minfo = -*info;
|
||||
LAPACK(xerbla)("CHETRF", &minfo);
|
||||
const blasint minfo = -*info;
|
||||
LAPACK(xerbla)("CHETRF", &minfo, strlen("CHETRF"));
|
||||
return;
|
||||
}
|
||||
|
||||
|
|
@ -64,7 +64,7 @@ void RELAPACK_chetrf_rook(
|
|||
const char cleanuplo = lower ? 'L' : 'U';
|
||||
|
||||
// Dummy argument
|
||||
int nout;
|
||||
blasint nout;
|
||||
|
||||
// Recursive kernel
|
||||
RELAPACK_chetrf_rook_rec(&cleanuplo, n, n, &nout, A, ldA, ipiv, cleanWork, n, info);
|
||||
|
|
@ -78,13 +78,13 @@ void RELAPACK_chetrf_rook(
|
|||
|
||||
/** chetrf_rook's recursive compute kernel */
|
||||
static void RELAPACK_chetrf_rook_rec(
|
||||
const char *uplo, const int *n_full, const int *n, int *n_out,
|
||||
float *A, const int *ldA, int *ipiv,
|
||||
float *Work, const int *ldWork, int *info
|
||||
const char *uplo, const blasint *n_full, const blasint *n, blasint *n_out,
|
||||
float *A, const blasint *ldA, blasint *ipiv,
|
||||
float *Work, const blasint *ldWork, blasint *info
|
||||
) {
|
||||
|
||||
// top recursion level?
|
||||
const int top = *n_full == *n;
|
||||
const blasint top = *n_full == *n;
|
||||
|
||||
if (*n <= MAX(CROSSOVER_CHETRF, 3)) {
|
||||
// Unblocked
|
||||
|
|
@ -96,31 +96,31 @@ static void RELAPACK_chetrf_rook_rec(
|
|||
return;
|
||||
}
|
||||
|
||||
int info1, info2;
|
||||
blasint info1, info2;
|
||||
|
||||
// Constants
|
||||
const float ONE[] = { 1., 0. };
|
||||
const float MONE[] = { -1., 0. };
|
||||
const int iONE[] = { 1 };
|
||||
const blasint iONE[] = { 1 };
|
||||
|
||||
const int n_rest = *n_full - *n;
|
||||
const blasint n_rest = *n_full - *n;
|
||||
|
||||
if (*uplo == 'L') {
|
||||
// Splitting (setup)
|
||||
int n1 = CREC_SPLIT(*n);
|
||||
int n2 = *n - n1;
|
||||
blasint n1 = CREC_SPLIT(*n);
|
||||
blasint n2 = *n - n1;
|
||||
|
||||
// Work_L *
|
||||
float *const Work_L = Work;
|
||||
|
||||
// recursion(A_L)
|
||||
int n1_out;
|
||||
blasint n1_out;
|
||||
RELAPACK_chetrf_rook_rec(uplo, n_full, &n1, &n1_out, A, ldA, ipiv, Work_L, ldWork, &info1);
|
||||
n1 = n1_out;
|
||||
|
||||
// Splitting (continued)
|
||||
n2 = *n - n1;
|
||||
const int n_full2 = *n_full - n1;
|
||||
const blasint n_full2 = *n_full - n1;
|
||||
|
||||
// * *
|
||||
// A_BL A_BR
|
||||
|
|
@ -136,23 +136,23 @@ static void RELAPACK_chetrf_rook_rec(
|
|||
// (top recursion level: use Work as Work_BR)
|
||||
float *const Work_BL = Work + 2 * n1;
|
||||
float *const Work_BR = top ? Work : Work + 2 * *ldWork * n1 + 2 * n1;
|
||||
const int ldWork_BR = top ? n2 : *ldWork;
|
||||
const blasint ldWork_BR = top ? n2 : *ldWork;
|
||||
|
||||
// ipiv_T
|
||||
// ipiv_B
|
||||
int *const ipiv_B = ipiv + n1;
|
||||
blasint *const ipiv_B = ipiv + n1;
|
||||
|
||||
// A_BR = A_BR - A_BL Work_BL'
|
||||
RELAPACK_cgemmt(uplo, "N", "T", &n2, &n1, MONE, A_BL, ldA, Work_BL, ldWork, ONE, A_BR, ldA);
|
||||
BLAS(cgemm)("N", "T", &n_rest, &n2, &n1, MONE, A_BL_B, ldA, Work_BL, ldWork, ONE, A_BR_B, ldA);
|
||||
|
||||
// recursion(A_BR)
|
||||
int n2_out;
|
||||
blasint n2_out;
|
||||
RELAPACK_chetrf_rook_rec(uplo, &n_full2, &n2, &n2_out, A_BR, ldA, ipiv_B, Work_BR, &ldWork_BR, &info2);
|
||||
|
||||
if (n2_out != n2) {
|
||||
// undo 1 column of updates
|
||||
const int n_restp1 = n_rest + 1;
|
||||
const blasint n_restp1 = n_rest + 1;
|
||||
|
||||
// last column of A_BR
|
||||
float *const A_BR_r = A_BR + 2 * *ldA * n2_out + 2 * n2_out;
|
||||
|
|
@ -169,7 +169,7 @@ static void RELAPACK_chetrf_rook_rec(
|
|||
n2 = n2_out;
|
||||
|
||||
// shift pivots
|
||||
int i;
|
||||
blasint i;
|
||||
for (i = 0; i < n2; i++)
|
||||
if (ipiv_B[i] > 0)
|
||||
ipiv_B[i] += n1;
|
||||
|
|
@ -180,22 +180,22 @@ static void RELAPACK_chetrf_rook_rec(
|
|||
*n_out = n1 + n2;
|
||||
} else {
|
||||
// Splitting (setup)
|
||||
int n2 = CREC_SPLIT(*n);
|
||||
int n1 = *n - n2;
|
||||
blasint n2 = CREC_SPLIT(*n);
|
||||
blasint n1 = *n - n2;
|
||||
|
||||
// * Work_R
|
||||
// (top recursion level: use Work as Work_R)
|
||||
float *const Work_R = top ? Work : Work + 2 * *ldWork * n1;
|
||||
|
||||
// recursion(A_R)
|
||||
int n2_out;
|
||||
blasint n2_out;
|
||||
RELAPACK_chetrf_rook_rec(uplo, n_full, &n2, &n2_out, A, ldA, ipiv, Work_R, ldWork, &info2);
|
||||
const int n2_diff = n2 - n2_out;
|
||||
const blasint n2_diff = n2 - n2_out;
|
||||
n2 = n2_out;
|
||||
|
||||
// Splitting (continued)
|
||||
n1 = *n - n2;
|
||||
const int n_full1 = *n_full - n2;
|
||||
const blasint n_full1 = *n_full - n2;
|
||||
|
||||
// * A_TL_T A_TR_T
|
||||
// * A_TL A_TR
|
||||
|
|
@ -211,19 +211,19 @@ static void RELAPACK_chetrf_rook_rec(
|
|||
// (top recursion level: Work_R was Work)
|
||||
float *const Work_L = Work;
|
||||
float *const Work_TR = Work + 2 * *ldWork * (top ? n2_diff : n1) + 2 * n_rest;
|
||||
const int ldWork_L = top ? n1 : *ldWork;
|
||||
const blasint ldWork_L = top ? n1 : *ldWork;
|
||||
|
||||
// A_TL = A_TL - A_TR Work_TR'
|
||||
RELAPACK_cgemmt(uplo, "N", "T", &n1, &n2, MONE, A_TR, ldA, Work_TR, ldWork, ONE, A_TL, ldA);
|
||||
BLAS(cgemm)("N", "T", &n_rest, &n1, &n2, MONE, A_TR_T, ldA, Work_TR, ldWork, ONE, A_TL_T, ldA);
|
||||
|
||||
// recursion(A_TL)
|
||||
int n1_out;
|
||||
blasint n1_out;
|
||||
RELAPACK_chetrf_rook_rec(uplo, &n_full1, &n1, &n1_out, A, ldA, ipiv, Work_L, &ldWork_L, &info1);
|
||||
|
||||
if (n1_out != n1) {
|
||||
// undo 1 column of updates
|
||||
const int n_restp1 = n_rest + 1;
|
||||
const blasint n_restp1 = n_rest + 1;
|
||||
|
||||
// A_TL_T_l = A_TL_T_l + A_TR_T Work_TR_t'
|
||||
BLAS(cgemv)("N", &n_restp1, &n2, ONE, A_TR_T, ldA, Work_TR, ldWork, ONE, A_TL_T, iONE);
|
||||
|
|
|
|||
|
|
@ -15,7 +15,7 @@
|
|||
/* Table of constant values */
|
||||
|
||||
static complex c_b1 = {1.f,0.f};
|
||||
static int c__1 = 1;
|
||||
static blasint c__1 = 1;
|
||||
|
||||
/** CHETRF_ROOK_REC2 computes a partial factorization of a complex Hermitian indefinite matrix using the boun ded Bunch-Kaufman ("rook") diagonal pivoting method
|
||||
*
|
||||
|
|
@ -24,12 +24,12 @@ static int c__1 = 1;
|
|||
* The blocked BLAS Level 3 updates were removed and moved to the
|
||||
* recursive algorithm.
|
||||
* */
|
||||
/* Subroutine */ void RELAPACK_chetrf_rook_rec2(char *uplo, int *n,
|
||||
int *nb, int *kb, complex *a, int *lda, int *ipiv,
|
||||
complex *w, int *ldw, int *info, ftnlen uplo_len)
|
||||
/* Subroutine */ void RELAPACK_chetrf_rook_rec2(char *uplo, blasint *n,
|
||||
int *nb, blasint *kb, complex *a, blasint *lda, blasint *ipiv,
|
||||
complex *w, blasint *ldw, blasint *info, ftnlen uplo_len)
|
||||
{
|
||||
/* System generated locals */
|
||||
int a_dim1, a_offset, w_dim1, w_offset, i__1, i__2, i__3, i__4;
|
||||
blasint a_dim1, a_offset, w_dim1, w_offset, i__1, i__2, i__3, i__4;
|
||||
float r__1, r__2;
|
||||
complex q__1, q__2, q__3, q__4, q__5;
|
||||
|
||||
|
|
@ -38,29 +38,29 @@ static int c__1 = 1;
|
|||
void r_cnjg(complex *, complex *), c_div(complex *, complex *, complex *);
|
||||
|
||||
/* Local variables */
|
||||
static int j, k, p;
|
||||
static blasint j, k, p;
|
||||
static float t, r1;
|
||||
static complex d11, d21, d22;
|
||||
static int ii, jj, kk, kp, kw, jp1, jp2, kkw;
|
||||
static blasint ii, jj, kk, kp, kw, jp1, jp2, kkw;
|
||||
static logical done;
|
||||
static int imax, jmax;
|
||||
static blasint imax, jmax;
|
||||
static float alpha;
|
||||
extern logical lsame_(char *, char *, ftnlen, ftnlen);
|
||||
extern /* Subroutine */ int cgemv_(char *, int *, int *, complex *
|
||||
, complex *, int *, complex *, int *, complex *, complex *
|
||||
, int *, ftnlen);
|
||||
extern /* Subroutine */ blasint cgemv_(char *, blasint *, blasint *, complex *
|
||||
, complex *, blasint *, complex *, blasint *, complex *, complex *
|
||||
, blasint *, ftnlen);
|
||||
static float sfmin;
|
||||
extern /* Subroutine */ int ccopy_(int *, complex *, int *,
|
||||
complex *, int *);
|
||||
static int itemp;
|
||||
extern /* Subroutine */ int cswap_(int *, complex *, int *,
|
||||
complex *, int *);
|
||||
static int kstep;
|
||||
extern /* Subroutine */ blasint ccopy_(int *, complex *, blasint *,
|
||||
complex *, blasint *);
|
||||
static blasint itemp;
|
||||
extern /* Subroutine */ blasint cswap_(int *, complex *, blasint *,
|
||||
complex *, blasint *);
|
||||
static blasint kstep;
|
||||
static float stemp, absakk;
|
||||
extern /* Subroutine */ int clacgv_(int *, complex *, int *);
|
||||
extern int icamax_(int *, complex *, int *);
|
||||
extern /* Subroutine */ blasint clacgv_(int *, complex *, blasint *);
|
||||
extern blasint icamax_(int *, complex *, blasint *);
|
||||
extern double slamch_(char *, ftnlen);
|
||||
extern /* Subroutine */ int csscal_(int *, float *, complex *, int
|
||||
extern /* Subroutine */ blasint csscal_(int *, float *, complex *, int
|
||||
*);
|
||||
static float colmax, rowmax;
|
||||
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
#include "relapack.h"
|
||||
|
||||
static void RELAPACK_clauum_rec(const char *, const int *, float *,
|
||||
const int *, int *);
|
||||
static void RELAPACK_clauum_rec(const char *, const blasint *, float *,
|
||||
const blasint *, blasint *);
|
||||
|
||||
|
||||
/** CLAUUM computes the product U * U**H or L**H * L, where the triangular factor U or L is stored in the upper or lower triangular part of the array A.
|
||||
|
|
@ -11,14 +11,14 @@ static void RELAPACK_clauum_rec(const char *, const int *, float *,
|
|||
* http://www.netlib.org/lapack/explore-html/d2/d36/clauum_8f.html
|
||||
* */
|
||||
void RELAPACK_clauum(
|
||||
const char *uplo, const int *n,
|
||||
float *A, const int *ldA,
|
||||
int *info
|
||||
const char *uplo, const blasint *n,
|
||||
float *A, const blasint *ldA,
|
||||
blasint *info
|
||||
) {
|
||||
|
||||
// Check arguments
|
||||
const int lower = LAPACK(lsame)(uplo, "L");
|
||||
const int upper = LAPACK(lsame)(uplo, "U");
|
||||
const blasint lower = LAPACK(lsame)(uplo, "L");
|
||||
const blasint upper = LAPACK(lsame)(uplo, "U");
|
||||
*info = 0;
|
||||
if (!lower && !upper)
|
||||
*info = -1;
|
||||
|
|
@ -27,8 +27,8 @@ void RELAPACK_clauum(
|
|||
else if (*ldA < MAX(1, *n))
|
||||
*info = -4;
|
||||
if (*info) {
|
||||
const int minfo = -*info;
|
||||
LAPACK(xerbla)("CLAUUM", &minfo);
|
||||
const blasint minfo = -*info;
|
||||
LAPACK(xerbla)("CLAUUM", &minfo, strlen("CLAUUM"));
|
||||
return;
|
||||
}
|
||||
|
||||
|
|
@ -42,9 +42,9 @@ void RELAPACK_clauum(
|
|||
|
||||
/** clauum's recursive compute kernel */
|
||||
static void RELAPACK_clauum_rec(
|
||||
const char *uplo, const int *n,
|
||||
float *A, const int *ldA,
|
||||
int *info
|
||||
const char *uplo, const blasint *n,
|
||||
float *A, const blasint *ldA,
|
||||
blasint *info
|
||||
) {
|
||||
|
||||
if (*n <= MAX(CROSSOVER_CLAUUM, 1)) {
|
||||
|
|
@ -57,8 +57,8 @@ static void RELAPACK_clauum_rec(
|
|||
const float ONE[] = { 1., 0. };
|
||||
|
||||
// Splitting
|
||||
const int n1 = CREC_SPLIT(*n);
|
||||
const int n2 = *n - n1;
|
||||
const blasint n1 = CREC_SPLIT(*n);
|
||||
const blasint n2 = *n - n1;
|
||||
|
||||
// A_TL A_TR
|
||||
// A_BL A_BR
|
||||
|
|
|
|||
|
|
@ -1,8 +1,8 @@
|
|||
#include "relapack.h"
|
||||
#include "stdlib.h"
|
||||
|
||||
static void RELAPACK_cpbtrf_rec(const char *, const int *, const int *,
|
||||
float *, const int *, float *, const int *, int *);
|
||||
static void RELAPACK_cpbtrf_rec(const char *, const blasint *, const blasint *,
|
||||
float *, const blasint *, float *, const blasint *, blasint *);
|
||||
|
||||
|
||||
/** CPBTRF computes the Cholesky factorization of a complex Hermitian positive definite band matrix A.
|
||||
|
|
@ -12,14 +12,14 @@ static void RELAPACK_cpbtrf_rec(const char *, const int *, const int *,
|
|||
* http://www.netlib.org/lapack/explore-html/de/d2d/cpbtrf_8f.html
|
||||
* */
|
||||
void RELAPACK_cpbtrf(
|
||||
const char *uplo, const int *n, const int *kd,
|
||||
float *Ab, const int *ldAb,
|
||||
int *info
|
||||
const char *uplo, const blasint *n, const blasint *kd,
|
||||
float *Ab, const blasint *ldAb,
|
||||
blasint *info
|
||||
) {
|
||||
|
||||
// Check arguments
|
||||
const int lower = LAPACK(lsame)(uplo, "L");
|
||||
const int upper = LAPACK(lsame)(uplo, "U");
|
||||
const blasint lower = LAPACK(lsame)(uplo, "L");
|
||||
const blasint upper = LAPACK(lsame)(uplo, "U");
|
||||
*info = 0;
|
||||
if (!lower && !upper)
|
||||
*info = -1;
|
||||
|
|
@ -30,8 +30,8 @@ void RELAPACK_cpbtrf(
|
|||
else if (*ldAb < *kd + 1)
|
||||
*info = -5;
|
||||
if (*info) {
|
||||
const int minfo = -*info;
|
||||
LAPACK(xerbla)("CPBTRF", &minfo);
|
||||
const blasint minfo = -*info;
|
||||
LAPACK(xerbla)("CPBTRF", &minfo, strlen("CPBTRF"));
|
||||
return;
|
||||
}
|
||||
|
||||
|
|
@ -42,9 +42,9 @@ void RELAPACK_cpbtrf(
|
|||
const float ZERO[] = { 0., 0. };
|
||||
|
||||
// Allocate work space
|
||||
const int n1 = CREC_SPLIT(*n);
|
||||
const int mWork = (*kd > n1) ? (lower ? *n - *kd : n1) : *kd;
|
||||
const int nWork = (*kd > n1) ? (lower ? n1 : *n - *kd) : *kd;
|
||||
const blasint n1 = CREC_SPLIT(*n);
|
||||
const blasint mWork = (*kd > n1) ? (lower ? *n - *kd : n1) : *kd;
|
||||
const blasint nWork = (*kd > n1) ? (lower ? n1 : *n - *kd) : *kd;
|
||||
float *Work = malloc(mWork * nWork * 2 * sizeof(float));
|
||||
LAPACK(claset)(uplo, &mWork, &nWork, ZERO, ZERO, Work, &mWork);
|
||||
|
||||
|
|
@ -58,10 +58,10 @@ void RELAPACK_cpbtrf(
|
|||
|
||||
/** cpbtrf's recursive compute kernel */
|
||||
static void RELAPACK_cpbtrf_rec(
|
||||
const char *uplo, const int *n, const int *kd,
|
||||
float *Ab, const int *ldAb,
|
||||
float *Work, const int *ldWork,
|
||||
int *info
|
||||
const char *uplo, const blasint *n, const blasint *kd,
|
||||
float *Ab, const blasint *ldAb,
|
||||
float *Work, const blasint *ldWork,
|
||||
blasint *info
|
||||
){
|
||||
|
||||
if (*n <= MAX(CROSSOVER_CPBTRF, 1)) {
|
||||
|
|
@ -75,12 +75,12 @@ static void RELAPACK_cpbtrf_rec(
|
|||
const float MONE[] = { -1., 0. };
|
||||
|
||||
// Unskew A
|
||||
const int ldA[] = { *ldAb - 1 };
|
||||
const blasint ldA[] = { *ldAb - 1 };
|
||||
float *const A = Ab + 2 * ((*uplo == 'L') ? 0 : *kd);
|
||||
|
||||
// Splitting
|
||||
const int n1 = MIN(CREC_SPLIT(*n), *kd);
|
||||
const int n2 = *n - n1;
|
||||
const blasint n1 = MIN(CREC_SPLIT(*n), *kd);
|
||||
const blasint n2 = *n - n1;
|
||||
|
||||
// * *
|
||||
// * Ab_BR
|
||||
|
|
@ -99,8 +99,8 @@ static void RELAPACK_cpbtrf_rec(
|
|||
return;
|
||||
|
||||
// Banded splitting
|
||||
const int n21 = MIN(n2, *kd - n1);
|
||||
const int n22 = MIN(n2 - n21, *kd);
|
||||
const blasint n21 = MIN(n2, *kd - n1);
|
||||
const blasint n22 = MIN(n2 - n21, *kd);
|
||||
|
||||
// n1 n21 n22
|
||||
// n1 * A_TRl A_TRr
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
#include "relapack.h"
|
||||
|
||||
static void RELAPACK_cpotrf_rec(const char *, const int *, float *,
|
||||
const int *, int *);
|
||||
static void RELAPACK_cpotrf_rec(const char *, const blasint *, float *,
|
||||
const blasint *, blasint *);
|
||||
|
||||
|
||||
/** CPOTRF computes the Cholesky factorization of a complex Hermitian positive definite matrix A.
|
||||
|
|
@ -11,14 +11,14 @@ static void RELAPACK_cpotrf_rec(const char *, const int *, float *,
|
|||
* http://www.netlib.org/lapack/explore-html/dd/dce/cpotrf_8f.html
|
||||
* */
|
||||
void RELAPACK_cpotrf(
|
||||
const char *uplo, const int *n,
|
||||
float *A, const int *ldA,
|
||||
int *info
|
||||
const char *uplo, const blasint *n,
|
||||
float *A, const blasint *ldA,
|
||||
blasint *info
|
||||
) {
|
||||
|
||||
// Check arguments
|
||||
const int lower = LAPACK(lsame)(uplo, "L");
|
||||
const int upper = LAPACK(lsame)(uplo, "U");
|
||||
const blasint lower = LAPACK(lsame)(uplo, "L");
|
||||
const blasint upper = LAPACK(lsame)(uplo, "U");
|
||||
*info = 0;
|
||||
if (!lower && !upper)
|
||||
*info = -1;
|
||||
|
|
@ -27,8 +27,8 @@ void RELAPACK_cpotrf(
|
|||
else if (*ldA < MAX(1, *n))
|
||||
*info = -4;
|
||||
if (*info) {
|
||||
const int minfo = -*info;
|
||||
LAPACK(xerbla)("CPOTRF", &minfo);
|
||||
const blasint minfo = -*info;
|
||||
LAPACK(xerbla)("CPOTRF", &minfo, strlen("CPOTRF"));
|
||||
return;
|
||||
}
|
||||
|
||||
|
|
@ -42,9 +42,9 @@ void RELAPACK_cpotrf(
|
|||
|
||||
/** cpotrf's recursive compute kernel */
|
||||
static void RELAPACK_cpotrf_rec(
|
||||
const char *uplo, const int *n,
|
||||
float *A, const int *ldA,
|
||||
int *info
|
||||
const char *uplo, const blasint *n,
|
||||
float *A, const blasint *ldA,
|
||||
blasint *info
|
||||
){
|
||||
|
||||
if (*n <= MAX(CROSSOVER_CPOTRF, 1)) {
|
||||
|
|
@ -58,8 +58,8 @@ static void RELAPACK_cpotrf_rec(
|
|||
const float MONE[] = { -1., 0. };
|
||||
|
||||
// Splitting
|
||||
const int n1 = CREC_SPLIT(*n);
|
||||
const int n2 = *n - n1;
|
||||
const blasint n1 = CREC_SPLIT(*n);
|
||||
const blasint n2 = *n - n1;
|
||||
|
||||
// A_TL A_TR
|
||||
// A_BL A_BR
|
||||
|
|
|
|||
|
|
@ -3,8 +3,8 @@
|
|||
#include <stdlib.h>
|
||||
#endif
|
||||
|
||||
static void RELAPACK_csytrf_rec(const char *, const int *, const int *, int *,
|
||||
float *, const int *, int *, float *, const int *, int *);
|
||||
static void RELAPACK_csytrf_rec(const char *, const blasint *, const blasint *, blasint *,
|
||||
float *, const blasint *, blasint *, float *, const blasint *, blasint *);
|
||||
|
||||
|
||||
/** CSYTRF computes the factorization of a complex symmetric matrix A using the Bunch-Kaufman diagonal pivoting method.
|
||||
|
|
@ -14,21 +14,21 @@ static void RELAPACK_csytrf_rec(const char *, const int *, const int *, int *,
|
|||
* http://www.netlib.org/lapack/explore-html/d5/d21/csytrf_8f.html
|
||||
* */
|
||||
void RELAPACK_csytrf(
|
||||
const char *uplo, const int *n,
|
||||
float *A, const int *ldA, int *ipiv,
|
||||
float *Work, const int *lWork, int *info
|
||||
const char *uplo, const blasint *n,
|
||||
float *A, const blasint *ldA, blasint *ipiv,
|
||||
float *Work, const blasint *lWork, blasint *info
|
||||
) {
|
||||
|
||||
// Required work size
|
||||
const int cleanlWork = *n * (*n / 2);
|
||||
int minlWork = cleanlWork;
|
||||
const blasint cleanlWork = *n * (*n / 2);
|
||||
blasint minlWork = cleanlWork;
|
||||
#if XSYTRF_ALLOW_MALLOC
|
||||
minlWork = 1;
|
||||
#endif
|
||||
|
||||
// Check arguments
|
||||
const int lower = LAPACK(lsame)(uplo, "L");
|
||||
const int upper = LAPACK(lsame)(uplo, "U");
|
||||
const blasint lower = LAPACK(lsame)(uplo, "L");
|
||||
const blasint upper = LAPACK(lsame)(uplo, "U");
|
||||
*info = 0;
|
||||
if (!lower && !upper)
|
||||
*info = -1;
|
||||
|
|
@ -55,8 +55,8 @@ void RELAPACK_csytrf(
|
|||
#endif
|
||||
|
||||
if (*info) {
|
||||
const int minfo = -*info;
|
||||
LAPACK(xerbla)("CSYTRF", &minfo);
|
||||
const blasint minfo = -*info;
|
||||
LAPACK(xerbla)("CSYTRF", &minfo, strlen("CSYTRF"));
|
||||
return;
|
||||
}
|
||||
|
||||
|
|
@ -64,7 +64,7 @@ void RELAPACK_csytrf(
|
|||
const char cleanuplo = lower ? 'L' : 'U';
|
||||
|
||||
// Dummy arguments
|
||||
int nout;
|
||||
blasint nout;
|
||||
|
||||
// Recursive kernel
|
||||
RELAPACK_csytrf_rec(&cleanuplo, n, n, &nout, A, ldA, ipiv, cleanWork, n, info);
|
||||
|
|
@ -78,13 +78,13 @@ void RELAPACK_csytrf(
|
|||
|
||||
/** csytrf's recursive compute kernel */
|
||||
static void RELAPACK_csytrf_rec(
|
||||
const char *uplo, const int *n_full, const int *n, int *n_out,
|
||||
float *A, const int *ldA, int *ipiv,
|
||||
float *Work, const int *ldWork, int *info
|
||||
const char *uplo, const blasint *n_full, const blasint *n, blasint *n_out,
|
||||
float *A, const blasint *ldA, blasint *ipiv,
|
||||
float *Work, const blasint *ldWork, blasint *info
|
||||
) {
|
||||
|
||||
// top recursion level?
|
||||
const int top = *n_full == *n;
|
||||
const blasint top = *n_full == *n;
|
||||
|
||||
if (*n <= MAX(CROSSOVER_CSYTRF, 3)) {
|
||||
// Unblocked
|
||||
|
|
@ -96,34 +96,34 @@ static void RELAPACK_csytrf_rec(
|
|||
return;
|
||||
}
|
||||
|
||||
int info1, info2;
|
||||
blasint info1, info2;
|
||||
|
||||
// Constants
|
||||
const float ONE[] = { 1., 0. };
|
||||
const float MONE[] = { -1., 0. };
|
||||
const int iONE[] = { 1 };
|
||||
const blasint iONE[] = { 1 };
|
||||
|
||||
// Loop iterator
|
||||
int i;
|
||||
blasint i;
|
||||
|
||||
const int n_rest = *n_full - *n;
|
||||
const blasint n_rest = *n_full - *n;
|
||||
|
||||
if (*uplo == 'L') {
|
||||
// Splitting (setup)
|
||||
int n1 = CREC_SPLIT(*n);
|
||||
int n2 = *n - n1;
|
||||
blasint n1 = CREC_SPLIT(*n);
|
||||
blasint n2 = *n - n1;
|
||||
|
||||
// Work_L *
|
||||
float *const Work_L = Work;
|
||||
|
||||
// recursion(A_L)
|
||||
int n1_out;
|
||||
blasint n1_out;
|
||||
RELAPACK_csytrf_rec(uplo, n_full, &n1, &n1_out, A, ldA, ipiv, Work_L, ldWork, &info1);
|
||||
n1 = n1_out;
|
||||
|
||||
// Splitting (continued)
|
||||
n2 = *n - n1;
|
||||
const int n_full2 = *n_full - n1;
|
||||
const blasint n_full2 = *n_full - n1;
|
||||
|
||||
// * *
|
||||
// A_BL A_BR
|
||||
|
|
@ -139,23 +139,23 @@ static void RELAPACK_csytrf_rec(
|
|||
// (top recursion level: use Work as Work_BR)
|
||||
float *const Work_BL = Work + 2 * n1;
|
||||
float *const Work_BR = top ? Work : Work + 2 * *ldWork * n1 + 2 * n1;
|
||||
const int ldWork_BR = top ? n2 : *ldWork;
|
||||
const blasint ldWork_BR = top ? n2 : *ldWork;
|
||||
|
||||
// ipiv_T
|
||||
// ipiv_B
|
||||
int *const ipiv_B = ipiv + n1;
|
||||
blasint *const ipiv_B = ipiv + n1;
|
||||
|
||||
// A_BR = A_BR - A_BL Work_BL'
|
||||
RELAPACK_cgemmt(uplo, "N", "T", &n2, &n1, MONE, A_BL, ldA, Work_BL, ldWork, ONE, A_BR, ldA);
|
||||
BLAS(cgemm)("N", "T", &n_rest, &n2, &n1, MONE, A_BL_B, ldA, Work_BL, ldWork, ONE, A_BR_B, ldA);
|
||||
|
||||
// recursion(A_BR)
|
||||
int n2_out;
|
||||
blasint n2_out;
|
||||
RELAPACK_csytrf_rec(uplo, &n_full2, &n2, &n2_out, A_BR, ldA, ipiv_B, Work_BR, &ldWork_BR, &info2);
|
||||
|
||||
if (n2_out != n2) {
|
||||
// undo 1 column of updates
|
||||
const int n_restp1 = n_rest + 1;
|
||||
const blasint n_restp1 = n_rest + 1;
|
||||
|
||||
// last column of A_BR
|
||||
float *const A_BR_r = A_BR + 2 * *ldA * n2_out + 2 * n2_out;
|
||||
|
|
@ -182,22 +182,22 @@ static void RELAPACK_csytrf_rec(
|
|||
*n_out = n1 + n2;
|
||||
} else {
|
||||
// Splitting (setup)
|
||||
int n2 = CREC_SPLIT(*n);
|
||||
int n1 = *n - n2;
|
||||
blasint n2 = CREC_SPLIT(*n);
|
||||
blasint n1 = *n - n2;
|
||||
|
||||
// * Work_R
|
||||
// (top recursion level: use Work as Work_R)
|
||||
float *const Work_R = top ? Work : Work + 2 * *ldWork * n1;
|
||||
|
||||
// recursion(A_R)
|
||||
int n2_out;
|
||||
blasint n2_out;
|
||||
RELAPACK_csytrf_rec(uplo, n_full, &n2, &n2_out, A, ldA, ipiv, Work_R, ldWork, &info2);
|
||||
const int n2_diff = n2 - n2_out;
|
||||
const blasint n2_diff = n2 - n2_out;
|
||||
n2 = n2_out;
|
||||
|
||||
// Splitting (continued)
|
||||
n1 = *n - n2;
|
||||
const int n_full1 = *n_full - n2;
|
||||
const blasint n_full1 = *n_full - n2;
|
||||
|
||||
// * A_TL_T A_TR_T
|
||||
// * A_TL A_TR
|
||||
|
|
@ -213,19 +213,19 @@ static void RELAPACK_csytrf_rec(
|
|||
// (top recursion level: Work_R was Work)
|
||||
float *const Work_L = Work;
|
||||
float *const Work_TR = Work + 2 * *ldWork * (top ? n2_diff : n1) + 2 * n_rest;
|
||||
const int ldWork_L = top ? n1 : *ldWork;
|
||||
const blasint ldWork_L = top ? n1 : *ldWork;
|
||||
|
||||
// A_TL = A_TL - A_TR Work_TR'
|
||||
RELAPACK_cgemmt(uplo, "N", "T", &n1, &n2, MONE, A_TR, ldA, Work_TR, ldWork, ONE, A_TL, ldA);
|
||||
BLAS(cgemm)("N", "T", &n_rest, &n1, &n2, MONE, A_TR_T, ldA, Work_TR, ldWork, ONE, A_TL_T, ldA);
|
||||
|
||||
// recursion(A_TL)
|
||||
int n1_out;
|
||||
blasint n1_out;
|
||||
RELAPACK_csytrf_rec(uplo, &n_full1, &n1, &n1_out, A, ldA, ipiv, Work_L, &ldWork_L, &info1);
|
||||
|
||||
if (n1_out != n1) {
|
||||
// undo 1 column of updates
|
||||
const int n_restp1 = n_rest + 1;
|
||||
const blasint n_restp1 = n_rest + 1;
|
||||
|
||||
// A_TL_T_l = A_TL_T_l + A_TR_T Work_TR_t'
|
||||
BLAS(cgemv)("N", &n_restp1, &n2, ONE, A_TR_T, ldA, Work_TR, ldWork, ONE, A_TL_T, iONE);
|
||||
|
|
|
|||
|
|
@ -15,7 +15,7 @@
|
|||
/* Table of constant values */
|
||||
|
||||
static complex c_b1 = {1.f,0.f};
|
||||
static int c__1 = 1;
|
||||
static blasint c__1 = 1;
|
||||
|
||||
/** CSYTRF_REC2 computes a partial factorization of a complex symmetric matrix using the Bunch-Kaufman diagon al pivoting method.
|
||||
*
|
||||
|
|
@ -24,12 +24,12 @@ static int c__1 = 1;
|
|||
* The blocked BLAS Level 3 updates were removed and moved to the
|
||||
* recursive algorithm.
|
||||
* */
|
||||
/* Subroutine */ void RELAPACK_csytrf_rec2(char *uplo, int *n, int *
|
||||
nb, int *kb, complex *a, int *lda, int *ipiv, complex *w,
|
||||
int *ldw, int *info, ftnlen uplo_len)
|
||||
/* Subroutine */ void RELAPACK_csytrf_rec2(char *uplo, blasint *n, blasint *
|
||||
nb, blasint *kb, complex *a, blasint *lda, blasint *ipiv, complex *w,
|
||||
int *ldw, blasint *info, ftnlen uplo_len)
|
||||
{
|
||||
/* System generated locals */
|
||||
int a_dim1, a_offset, w_dim1, w_offset, i__1, i__2, i__3, i__4;
|
||||
blasint a_dim1, a_offset, w_dim1, w_offset, i__1, i__2, i__3, i__4;
|
||||
float r__1, r__2, r__3, r__4;
|
||||
complex q__1, q__2, q__3;
|
||||
|
||||
|
|
@ -38,21 +38,21 @@ static int c__1 = 1;
|
|||
void c_div(complex *, complex *, complex *);
|
||||
|
||||
/* Local variables */
|
||||
static int j, k;
|
||||
static blasint j, k;
|
||||
static complex t, r1, d11, d21, d22;
|
||||
static int jj, kk, jp, kp, kw, kkw, imax, jmax;
|
||||
static blasint jj, kk, jp, kp, kw, kkw, imax, jmax;
|
||||
static float alpha;
|
||||
extern /* Subroutine */ int cscal_(int *, complex *, complex *,
|
||||
int *);
|
||||
extern /* Subroutine */ blasint cscal_(int *, complex *, complex *,
|
||||
blasint *);
|
||||
extern logical lsame_(char *, char *, ftnlen, ftnlen);
|
||||
extern /* Subroutine */ int cgemv_(char *, int *, int *, complex *
|
||||
, complex *, int *, complex *, int *, complex *, complex *
|
||||
, int *, ftnlen), ccopy_(int *, complex *, int *,
|
||||
complex *, int *), cswap_(int *, complex *, int *,
|
||||
complex *, int *);
|
||||
static int kstep;
|
||||
extern /* Subroutine */ blasint cgemv_(char *, blasint *, blasint *, complex *
|
||||
, complex *, blasint *, complex *, blasint *, complex *, complex *
|
||||
, blasint *, ftnlen), ccopy_(int *, complex *, blasint *,
|
||||
complex *, blasint *), cswap_(int *, complex *, blasint *,
|
||||
complex *, blasint *);
|
||||
static blasint kstep;
|
||||
static float absakk;
|
||||
extern int icamax_(int *, complex *, int *);
|
||||
extern blasint icamax_(int *, complex *, blasint *);
|
||||
static float colmax, rowmax;
|
||||
|
||||
/* Parameter adjustments */
|
||||
|
|
|
|||
|
|
@ -3,8 +3,8 @@
|
|||
#include <stdlib.h>
|
||||
#endif
|
||||
|
||||
static void RELAPACK_csytrf_rook_rec(const char *, const int *, const int *, int *,
|
||||
float *, const int *, int *, float *, const int *, int *);
|
||||
static void RELAPACK_csytrf_rook_rec(const char *, const blasint *, const blasint *, blasint *,
|
||||
float *, const blasint *, blasint *, float *, const blasint *, blasint *);
|
||||
|
||||
|
||||
/** CSYTRF_ROOK computes the factorization of a complex symmetric matrix A using the bounded Bunch-Kaufman ("rook") diagonal pivoting method.
|
||||
|
|
@ -14,21 +14,21 @@ static void RELAPACK_csytrf_rook_rec(const char *, const int *, const int *, int
|
|||
* http://www.netlib.org/lapack/explore-html/d8/dc8/csytrf__rook_8f.html
|
||||
* */
|
||||
void RELAPACK_csytrf_rook(
|
||||
const char *uplo, const int *n,
|
||||
float *A, const int *ldA, int *ipiv,
|
||||
float *Work, const int *lWork, int *info
|
||||
const char *uplo, const blasint *n,
|
||||
float *A, const blasint *ldA, blasint *ipiv,
|
||||
float *Work, const blasint *lWork, blasint *info
|
||||
) {
|
||||
|
||||
// Required work size
|
||||
const int cleanlWork = *n * (*n / 2);
|
||||
int minlWork = cleanlWork;
|
||||
const blasint cleanlWork = *n * (*n / 2);
|
||||
blasint minlWork = cleanlWork;
|
||||
#if XSYTRF_ALLOW_MALLOC
|
||||
minlWork = 1;
|
||||
#endif
|
||||
|
||||
// Check arguments
|
||||
const int lower = LAPACK(lsame)(uplo, "L");
|
||||
const int upper = LAPACK(lsame)(uplo, "U");
|
||||
const blasint lower = LAPACK(lsame)(uplo, "L");
|
||||
const blasint upper = LAPACK(lsame)(uplo, "U");
|
||||
*info = 0;
|
||||
if (!lower && !upper)
|
||||
*info = -1;
|
||||
|
|
@ -55,8 +55,8 @@ void RELAPACK_csytrf_rook(
|
|||
#endif
|
||||
|
||||
if (*info) {
|
||||
const int minfo = -*info;
|
||||
LAPACK(xerbla)("CSYTRF", &minfo);
|
||||
const blasint minfo = -*info;
|
||||
LAPACK(xerbla)("CSYTRF", &minfo, strlen("CSYTRF"));
|
||||
return;
|
||||
}
|
||||
|
||||
|
|
@ -64,7 +64,7 @@ void RELAPACK_csytrf_rook(
|
|||
const char cleanuplo = lower ? 'L' : 'U';
|
||||
|
||||
// Dummy argument
|
||||
int nout;
|
||||
blasint nout;
|
||||
|
||||
// Recursive kernel
|
||||
RELAPACK_csytrf_rook_rec(&cleanuplo, n, n, &nout, A, ldA, ipiv, cleanWork, n, info);
|
||||
|
|
@ -78,13 +78,13 @@ void RELAPACK_csytrf_rook(
|
|||
|
||||
/** csytrf_rook's recursive compute kernel */
|
||||
static void RELAPACK_csytrf_rook_rec(
|
||||
const char *uplo, const int *n_full, const int *n, int *n_out,
|
||||
float *A, const int *ldA, int *ipiv,
|
||||
float *Work, const int *ldWork, int *info
|
||||
const char *uplo, const blasint *n_full, const blasint *n, blasint *n_out,
|
||||
float *A, const blasint *ldA, blasint *ipiv,
|
||||
float *Work, const blasint *ldWork, blasint *info
|
||||
) {
|
||||
|
||||
// top recursion level?
|
||||
const int top = *n_full == *n;
|
||||
const blasint top = *n_full == *n;
|
||||
|
||||
if (*n <= MAX(CROSSOVER_CSYTRF_ROOK, 3)) {
|
||||
// Unblocked
|
||||
|
|
@ -96,31 +96,31 @@ static void RELAPACK_csytrf_rook_rec(
|
|||
return;
|
||||
}
|
||||
|
||||
int info1, info2;
|
||||
blasint info1, info2;
|
||||
|
||||
// Constants
|
||||
const float ONE[] = { 1., 0. };
|
||||
const float MONE[] = { -1., 0. };
|
||||
const int iONE[] = { 1 };
|
||||
const blasint iONE[] = { 1 };
|
||||
|
||||
const int n_rest = *n_full - *n;
|
||||
const blasint n_rest = *n_full - *n;
|
||||
|
||||
if (*uplo == 'L') {
|
||||
// Splitting (setup)
|
||||
int n1 = CREC_SPLIT(*n);
|
||||
int n2 = *n - n1;
|
||||
blasint n1 = CREC_SPLIT(*n);
|
||||
blasint n2 = *n - n1;
|
||||
|
||||
// Work_L *
|
||||
float *const Work_L = Work;
|
||||
|
||||
// recursion(A_L)
|
||||
int n1_out;
|
||||
blasint n1_out;
|
||||
RELAPACK_csytrf_rook_rec(uplo, n_full, &n1, &n1_out, A, ldA, ipiv, Work_L, ldWork, &info1);
|
||||
n1 = n1_out;
|
||||
|
||||
// Splitting (continued)
|
||||
n2 = *n - n1;
|
||||
const int n_full2 = *n_full - n1;
|
||||
const blasint n_full2 = *n_full - n1;
|
||||
|
||||
// * *
|
||||
// A_BL A_BR
|
||||
|
|
@ -136,23 +136,23 @@ static void RELAPACK_csytrf_rook_rec(
|
|||
// (top recursion level: use Work as Work_BR)
|
||||
float *const Work_BL = Work + 2 * n1;
|
||||
float *const Work_BR = top ? Work : Work + 2 * *ldWork * n1 + 2 * n1;
|
||||
const int ldWork_BR = top ? n2 : *ldWork;
|
||||
const blasint ldWork_BR = top ? n2 : *ldWork;
|
||||
|
||||
// ipiv_T
|
||||
// ipiv_B
|
||||
int *const ipiv_B = ipiv + n1;
|
||||
blasint *const ipiv_B = ipiv + n1;
|
||||
|
||||
// A_BR = A_BR - A_BL Work_BL'
|
||||
RELAPACK_cgemmt(uplo, "N", "T", &n2, &n1, MONE, A_BL, ldA, Work_BL, ldWork, ONE, A_BR, ldA);
|
||||
BLAS(cgemm)("N", "T", &n_rest, &n2, &n1, MONE, A_BL_B, ldA, Work_BL, ldWork, ONE, A_BR_B, ldA);
|
||||
|
||||
// recursion(A_BR)
|
||||
int n2_out;
|
||||
blasint n2_out;
|
||||
RELAPACK_csytrf_rook_rec(uplo, &n_full2, &n2, &n2_out, A_BR, ldA, ipiv_B, Work_BR, &ldWork_BR, &info2);
|
||||
|
||||
if (n2_out != n2) {
|
||||
// undo 1 column of updates
|
||||
const int n_restp1 = n_rest + 1;
|
||||
const blasint n_restp1 = n_rest + 1;
|
||||
|
||||
// last column of A_BR
|
||||
float *const A_BR_r = A_BR + 2 * *ldA * n2_out + 2 * n2_out;
|
||||
|
|
@ -169,7 +169,7 @@ static void RELAPACK_csytrf_rook_rec(
|
|||
n2 = n2_out;
|
||||
|
||||
// shift pivots
|
||||
int i;
|
||||
blasint i;
|
||||
for (i = 0; i < n2; i++)
|
||||
if (ipiv_B[i] > 0)
|
||||
ipiv_B[i] += n1;
|
||||
|
|
@ -180,22 +180,22 @@ static void RELAPACK_csytrf_rook_rec(
|
|||
*n_out = n1 + n2;
|
||||
} else {
|
||||
// Splitting (setup)
|
||||
int n2 = CREC_SPLIT(*n);
|
||||
int n1 = *n - n2;
|
||||
blasint n2 = CREC_SPLIT(*n);
|
||||
blasint n1 = *n - n2;
|
||||
|
||||
// * Work_R
|
||||
// (top recursion level: use Work as Work_R)
|
||||
float *const Work_R = top ? Work : Work + 2 * *ldWork * n1;
|
||||
|
||||
// recursion(A_R)
|
||||
int n2_out;
|
||||
blasint n2_out;
|
||||
RELAPACK_csytrf_rook_rec(uplo, n_full, &n2, &n2_out, A, ldA, ipiv, Work_R, ldWork, &info2);
|
||||
const int n2_diff = n2 - n2_out;
|
||||
const blasint n2_diff = n2 - n2_out;
|
||||
n2 = n2_out;
|
||||
|
||||
// Splitting (continued)
|
||||
n1 = *n - n2;
|
||||
const int n_full1 = *n_full - n2;
|
||||
const blasint n_full1 = *n_full - n2;
|
||||
|
||||
// * A_TL_T A_TR_T
|
||||
// * A_TL A_TR
|
||||
|
|
@ -211,19 +211,19 @@ static void RELAPACK_csytrf_rook_rec(
|
|||
// (top recursion level: Work_R was Work)
|
||||
float *const Work_L = Work;
|
||||
float *const Work_TR = Work + 2 * *ldWork * (top ? n2_diff : n1) + 2 * n_rest;
|
||||
const int ldWork_L = top ? n1 : *ldWork;
|
||||
const blasint ldWork_L = top ? n1 : *ldWork;
|
||||
|
||||
// A_TL = A_TL - A_TR Work_TR'
|
||||
RELAPACK_cgemmt(uplo, "N", "T", &n1, &n2, MONE, A_TR, ldA, Work_TR, ldWork, ONE, A_TL, ldA);
|
||||
BLAS(cgemm)("N", "T", &n_rest, &n1, &n2, MONE, A_TR_T, ldA, Work_TR, ldWork, ONE, A_TL_T, ldA);
|
||||
|
||||
// recursion(A_TL)
|
||||
int n1_out;
|
||||
blasint n1_out;
|
||||
RELAPACK_csytrf_rook_rec(uplo, &n_full1, &n1, &n1_out, A, ldA, ipiv, Work_L, &ldWork_L, &info1);
|
||||
|
||||
if (n1_out != n1) {
|
||||
// undo 1 column of updates
|
||||
const int n_restp1 = n_rest + 1;
|
||||
const blasint n_restp1 = n_rest + 1;
|
||||
|
||||
// A_TL_T_l = A_TL_T_l + A_TR_T Work_TR_t'
|
||||
BLAS(cgemv)("N", &n_restp1, &n2, ONE, A_TR_T, ldA, Work_TR, ldWork, ONE, A_TL_T, iONE);
|
||||
|
|
|
|||
|
|
@ -15,7 +15,7 @@
|
|||
/* Table of constant values */
|
||||
|
||||
static complex c_b1 = {1.f,0.f};
|
||||
static int c__1 = 1;
|
||||
static blasint c__1 = 1;
|
||||
|
||||
/** CSYTRF_ROOK_REC2 computes a partial factorization of a complex symmetric matrix using the bounded Bunch-K aufman ("rook") diagonal pivoting method.
|
||||
*
|
||||
|
|
@ -24,12 +24,12 @@ static int c__1 = 1;
|
|||
* The blocked BLAS Level 3 updates were removed and moved to the
|
||||
* recursive algorithm.
|
||||
* */
|
||||
/* Subroutine */ void RELAPACK_csytrf_rook_rec2(char *uplo, int *n,
|
||||
int *nb, int *kb, complex *a, int *lda, int *ipiv,
|
||||
complex *w, int *ldw, int *info, ftnlen uplo_len)
|
||||
/* Subroutine */ void RELAPACK_csytrf_rook_rec2(char *uplo, blasint *n,
|
||||
int *nb, blasint *kb, complex *a, blasint *lda, blasint *ipiv,
|
||||
complex *w, blasint *ldw, blasint *info, ftnlen uplo_len)
|
||||
{
|
||||
/* System generated locals */
|
||||
int a_dim1, a_offset, w_dim1, w_offset, i__1, i__2, i__3, i__4;
|
||||
blasint a_dim1, a_offset, w_dim1, w_offset, i__1, i__2, i__3, i__4;
|
||||
float r__1, r__2;
|
||||
complex q__1, q__2, q__3, q__4;
|
||||
|
||||
|
|
@ -38,27 +38,27 @@ static int c__1 = 1;
|
|||
void c_div(complex *, complex *, complex *);
|
||||
|
||||
/* Local variables */
|
||||
static int j, k, p;
|
||||
static blasint j, k, p;
|
||||
static complex t, r1, d11, d12, d21, d22;
|
||||
static int ii, jj, kk, kp, kw, jp1, jp2, kkw;
|
||||
static blasint ii, jj, kk, kp, kw, jp1, jp2, kkw;
|
||||
static logical done;
|
||||
static int imax, jmax;
|
||||
static blasint imax, jmax;
|
||||
static float alpha;
|
||||
extern /* Subroutine */ int cscal_(int *, complex *, complex *,
|
||||
int *);
|
||||
extern /* Subroutine */ blasint cscal_(int *, complex *, complex *,
|
||||
blasint *);
|
||||
extern logical lsame_(char *, char *, ftnlen, ftnlen);
|
||||
extern /* Subroutine */ int cgemv_(char *, int *, int *, complex *
|
||||
, complex *, int *, complex *, int *, complex *, complex *
|
||||
, int *, ftnlen);
|
||||
extern /* Subroutine */ blasint cgemv_(char *, blasint *, blasint *, complex *
|
||||
, complex *, blasint *, complex *, blasint *, complex *, complex *
|
||||
, blasint *, ftnlen);
|
||||
static float sfmin;
|
||||
extern /* Subroutine */ int ccopy_(int *, complex *, int *,
|
||||
complex *, int *);
|
||||
static int itemp;
|
||||
extern /* Subroutine */ int cswap_(int *, complex *, int *,
|
||||
complex *, int *);
|
||||
static int kstep;
|
||||
extern /* Subroutine */ blasint ccopy_(int *, complex *, blasint *,
|
||||
complex *, blasint *);
|
||||
static blasint itemp;
|
||||
extern /* Subroutine */ blasint cswap_(int *, complex *, blasint *,
|
||||
complex *, blasint *);
|
||||
static blasint kstep;
|
||||
static float stemp, absakk;
|
||||
extern int icamax_(int *, complex *, int *);
|
||||
extern blasint icamax_(int *, complex *, blasint *);
|
||||
extern double slamch_(char *, ftnlen);
|
||||
static float colmax, rowmax;
|
||||
|
||||
|
|
|
|||
|
|
@ -1,10 +1,10 @@
|
|||
#include "relapack.h"
|
||||
#include <math.h>
|
||||
|
||||
static void RELAPACK_ctgsyl_rec(const char *, const int *, const int *,
|
||||
const int *, const float *, const int *, const float *, const int *,
|
||||
float *, const int *, const float *, const int *, const float *,
|
||||
const int *, float *, const int *, float *, float *, float *, int *);
|
||||
static void RELAPACK_ctgsyl_rec(const char *, const blasint *, const blasint *,
|
||||
const blasint *, const float *, const blasint *, const float *, const blasint *,
|
||||
float *, const blasint *, const float *, const blasint *, const float *,
|
||||
const blasint *, float *, const blasint *, float *, float *, float *, blasint *);
|
||||
|
||||
|
||||
/** CTGSYL solves the generalized Sylvester equation.
|
||||
|
|
@ -14,21 +14,21 @@ static void RELAPACK_ctgsyl_rec(const char *, const int *, const int *,
|
|||
* http://www.netlib.org/lapack/explore-html/d7/de7/ctgsyl_8f.html
|
||||
* */
|
||||
void RELAPACK_ctgsyl(
|
||||
const char *trans, const int *ijob, const int *m, const int *n,
|
||||
const float *A, const int *ldA, const float *B, const int *ldB,
|
||||
float *C, const int *ldC,
|
||||
const float *D, const int *ldD, const float *E, const int *ldE,
|
||||
float *F, const int *ldF,
|
||||
const char *trans, const blasint *ijob, const blasint *m, const blasint *n,
|
||||
const float *A, const blasint *ldA, const float *B, const blasint *ldB,
|
||||
float *C, const blasint *ldC,
|
||||
const float *D, const blasint *ldD, const float *E, const blasint *ldE,
|
||||
float *F, const blasint *ldF,
|
||||
float *scale, float *dif,
|
||||
float *Work, const int *lWork, int *iWork, int *info
|
||||
float *Work, const blasint *lWork, blasint *iWork, blasint *info
|
||||
) {
|
||||
|
||||
// Parse arguments
|
||||
const int notran = LAPACK(lsame)(trans, "N");
|
||||
const int tran = LAPACK(lsame)(trans, "C");
|
||||
const blasint notran = LAPACK(lsame)(trans, "N");
|
||||
const blasint tran = LAPACK(lsame)(trans, "C");
|
||||
|
||||
// Compute work buffer size
|
||||
int lwmin = 1;
|
||||
blasint lwmin = 1;
|
||||
if (notran && (*ijob == 1 || *ijob == 2))
|
||||
lwmin = MAX(1, 2 * *m * *n);
|
||||
*info = 0;
|
||||
|
|
@ -57,8 +57,8 @@ void RELAPACK_ctgsyl(
|
|||
else if (*lWork < lwmin && *lWork != -1)
|
||||
*info = -20;
|
||||
if (*info) {
|
||||
const int minfo = -*info;
|
||||
LAPACK(xerbla)("CTGSYL", &minfo);
|
||||
const blasint minfo = -*info;
|
||||
LAPACK(xerbla)("CTGSYL", &minfo, strlen("CTGSYL"));
|
||||
return;
|
||||
}
|
||||
|
||||
|
|
@ -74,8 +74,8 @@ void RELAPACK_ctgsyl(
|
|||
// Constant
|
||||
const float ZERO[] = { 0., 0. };
|
||||
|
||||
int isolve = 1;
|
||||
int ifunc = 0;
|
||||
blasint isolve = 1;
|
||||
blasint ifunc = 0;
|
||||
if (notran) {
|
||||
if (*ijob >= 3) {
|
||||
ifunc = *ijob - 2;
|
||||
|
|
@ -86,7 +86,7 @@ void RELAPACK_ctgsyl(
|
|||
}
|
||||
|
||||
float scale2;
|
||||
int iround;
|
||||
blasint iround;
|
||||
for (iround = 1; iround <= isolve; iround++) {
|
||||
*scale = 1;
|
||||
float dscale = 0;
|
||||
|
|
@ -119,13 +119,13 @@ void RELAPACK_ctgsyl(
|
|||
|
||||
/** ctgsyl's recursive vompute kernel */
|
||||
static void RELAPACK_ctgsyl_rec(
|
||||
const char *trans, const int *ifunc, const int *m, const int *n,
|
||||
const float *A, const int *ldA, const float *B, const int *ldB,
|
||||
float *C, const int *ldC,
|
||||
const float *D, const int *ldD, const float *E, const int *ldE,
|
||||
float *F, const int *ldF,
|
||||
const char *trans, const blasint *ifunc, const blasint *m, const blasint *n,
|
||||
const float *A, const blasint *ldA, const float *B, const blasint *ldB,
|
||||
float *C, const blasint *ldC,
|
||||
const float *D, const blasint *ldD, const float *E, const blasint *ldE,
|
||||
float *F, const blasint *ldF,
|
||||
float *scale, float *dsum, float *dscale,
|
||||
int *info
|
||||
blasint *info
|
||||
) {
|
||||
|
||||
if (*m <= MAX(CROSSOVER_CTGSYL, 1) && *n <= MAX(CROSSOVER_CTGSYL, 1)) {
|
||||
|
|
@ -137,18 +137,18 @@ static void RELAPACK_ctgsyl_rec(
|
|||
// Constants
|
||||
const float ONE[] = { 1., 0. };
|
||||
const float MONE[] = { -1., 0. };
|
||||
const int iONE[] = { 1 };
|
||||
const blasint iONE[] = { 1 };
|
||||
|
||||
// Outputs
|
||||
float scale1[] = { 1., 0. };
|
||||
float scale2[] = { 1., 0. };
|
||||
int info1[] = { 0 };
|
||||
int info2[] = { 0 };
|
||||
blasint info1[] = { 0 };
|
||||
blasint info2[] = { 0 };
|
||||
|
||||
if (*m > *n) {
|
||||
// Splitting
|
||||
const int m1 = CREC_SPLIT(*m);
|
||||
const int m2 = *m - m1;
|
||||
const blasint m1 = CREC_SPLIT(*m);
|
||||
const blasint m2 = *m - m1;
|
||||
|
||||
// A_TL A_TR
|
||||
// 0 A_BR
|
||||
|
|
@ -206,8 +206,8 @@ static void RELAPACK_ctgsyl_rec(
|
|||
}
|
||||
} else {
|
||||
// Splitting
|
||||
const int n1 = CREC_SPLIT(*n);
|
||||
const int n2 = *n - n1;
|
||||
const blasint n1 = CREC_SPLIT(*n);
|
||||
const blasint n2 = *n - n1;
|
||||
|
||||
// B_TL B_TR
|
||||
// 0 B_BR
|
||||
|
|
|
|||
|
|
@ -1,8 +1,8 @@
|
|||
#include "relapack.h"
|
||||
|
||||
static void RELAPACK_ctrsyl_rec(const char *, const char *, const int *,
|
||||
const int *, const int *, const float *, const int *, const float *,
|
||||
const int *, float *, const int *, float *, int *);
|
||||
static void RELAPACK_ctrsyl_rec(const char *, const char *, const blasint *,
|
||||
const blasint *, const blasint *, const float *, const blasint *, const float *,
|
||||
const blasint *, float *, const blasint *, float *, blasint *);
|
||||
|
||||
|
||||
/** CTRSYL solves the complex Sylvester matrix equation.
|
||||
|
|
@ -12,18 +12,18 @@ static void RELAPACK_ctrsyl_rec(const char *, const char *, const int *,
|
|||
* http://www.netlib.org/lapack/explore-html/d8/df4/ctrsyl_8f.html
|
||||
* */
|
||||
void RELAPACK_ctrsyl(
|
||||
const char *tranA, const char *tranB, const int *isgn,
|
||||
const int *m, const int *n,
|
||||
const float *A, const int *ldA, const float *B, const int *ldB,
|
||||
float *C, const int *ldC, float *scale,
|
||||
int *info
|
||||
const char *tranA, const char *tranB, const blasint *isgn,
|
||||
const blasint *m, const blasint *n,
|
||||
const float *A, const blasint *ldA, const float *B, const blasint *ldB,
|
||||
float *C, const blasint *ldC, float *scale,
|
||||
blasint *info
|
||||
) {
|
||||
|
||||
// Check arguments
|
||||
const int notransA = LAPACK(lsame)(tranA, "N");
|
||||
const int ctransA = LAPACK(lsame)(tranA, "C");
|
||||
const int notransB = LAPACK(lsame)(tranB, "N");
|
||||
const int ctransB = LAPACK(lsame)(tranB, "C");
|
||||
const blasint notransA = LAPACK(lsame)(tranA, "N");
|
||||
const blasint ctransA = LAPACK(lsame)(tranA, "C");
|
||||
const blasint notransB = LAPACK(lsame)(tranB, "N");
|
||||
const blasint ctransB = LAPACK(lsame)(tranB, "C");
|
||||
*info = 0;
|
||||
if (!ctransA && !notransA)
|
||||
*info = -1;
|
||||
|
|
@ -42,8 +42,8 @@ void RELAPACK_ctrsyl(
|
|||
else if (*ldC < MAX(1, *m))
|
||||
*info = -11;
|
||||
if (*info) {
|
||||
const int minfo = -*info;
|
||||
LAPACK(xerbla)("CTRSYL", &minfo);
|
||||
const blasint minfo = -*info;
|
||||
LAPACK(xerbla)("CTRSYL", &minfo, strlen("CTRSYL"));
|
||||
return;
|
||||
}
|
||||
|
||||
|
|
@ -58,11 +58,11 @@ void RELAPACK_ctrsyl(
|
|||
|
||||
/** ctrsyl's recursive compute kernel */
|
||||
static void RELAPACK_ctrsyl_rec(
|
||||
const char *tranA, const char *tranB, const int *isgn,
|
||||
const int *m, const int *n,
|
||||
const float *A, const int *ldA, const float *B, const int *ldB,
|
||||
float *C, const int *ldC, float *scale,
|
||||
int *info
|
||||
const char *tranA, const char *tranB, const blasint *isgn,
|
||||
const blasint *m, const blasint *n,
|
||||
const float *A, const blasint *ldA, const float *B, const blasint *ldB,
|
||||
float *C, const blasint *ldC, float *scale,
|
||||
blasint *info
|
||||
) {
|
||||
|
||||
if (*m <= MAX(CROSSOVER_CTRSYL, 1) && *n <= MAX(CROSSOVER_CTRSYL, 1)) {
|
||||
|
|
@ -75,18 +75,18 @@ static void RELAPACK_ctrsyl_rec(
|
|||
const float ONE[] = { 1., 0. };
|
||||
const float MONE[] = { -1., 0. };
|
||||
const float MSGN[] = { -*isgn, 0. };
|
||||
const int iONE[] = { 1 };
|
||||
const blasint iONE[] = { 1 };
|
||||
|
||||
// Outputs
|
||||
float scale1[] = { 1., 0. };
|
||||
float scale2[] = { 1., 0. };
|
||||
int info1[] = { 0 };
|
||||
int info2[] = { 0 };
|
||||
blasint info1[] = { 0 };
|
||||
blasint info2[] = { 0 };
|
||||
|
||||
if (*m > *n) {
|
||||
// Splitting
|
||||
const int m1 = CREC_SPLIT(*m);
|
||||
const int m2 = *m - m1;
|
||||
const blasint m1 = CREC_SPLIT(*m);
|
||||
const blasint m2 = *m - m1;
|
||||
|
||||
// A_TL A_TR
|
||||
// 0 A_BR
|
||||
|
|
@ -122,8 +122,8 @@ static void RELAPACK_ctrsyl_rec(
|
|||
}
|
||||
} else {
|
||||
// Splitting
|
||||
const int n1 = CREC_SPLIT(*n);
|
||||
const int n2 = *n - n1;
|
||||
const blasint n1 = CREC_SPLIT(*n);
|
||||
const blasint n2 = *n - n1;
|
||||
|
||||
// B_TL B_TR
|
||||
// 0 B_BR
|
||||
|
|
|
|||
|
|
@ -14,16 +14,16 @@
|
|||
#include "f2c.h"
|
||||
|
||||
#if BLAS_COMPLEX_FUNCTIONS_AS_ROUTINES
|
||||
complex cdotu_fun(int *n, complex *x, int *incx, complex *y, int *incy) {
|
||||
extern void cdotu_(complex *, int *, complex *, int *, complex *, int *);
|
||||
complex cdotu_fun(int *n, complex *x, blasint *incx, complex *y, blasint *incy) {
|
||||
extern void cdotu_(complex *, blasint *, complex *, blasint *, complex *, blasint *);
|
||||
complex result;
|
||||
cdotu_(&result, n, x, incx, y, incy);
|
||||
return result;
|
||||
}
|
||||
#define cdotu_ cdotu_fun
|
||||
|
||||
complex cdotc_fun(int *n, complex *x, int *incx, complex *y, int *incy) {
|
||||
extern void cdotc_(complex *, int *, complex *, int *, complex *, int *);
|
||||
complex cdotc_fun(int *n, complex *x, blasint *incx, complex *y, blasint *incy) {
|
||||
extern void cdotc_(complex *, blasint *, complex *, blasint *, complex *, blasint *);
|
||||
complex result;
|
||||
cdotc_(&result, n, x, incx, y, incy);
|
||||
return result;
|
||||
|
|
@ -43,7 +43,7 @@ complex cladiv_fun(complex *a, complex *b) {
|
|||
|
||||
/* Table of constant values */
|
||||
|
||||
static int c__1 = 1;
|
||||
static blasint c__1 = 1;
|
||||
|
||||
/** RELAPACK_CTRSYL_REC2 solves the complex Sylvester matrix equation (unblocked algorithm)
|
||||
*
|
||||
|
|
@ -51,12 +51,12 @@ static int c__1 = 1;
|
|||
* It serves as an unblocked kernel in the recursive algorithms.
|
||||
* */
|
||||
/* Subroutine */ void RELAPACK_ctrsyl_rec2(char *trana, char *tranb, int
|
||||
*isgn, int *m, int *n, complex *a, int *lda, complex *b,
|
||||
int *ldb, complex *c__, int *ldc, float *scale, int *info,
|
||||
*isgn, blasint *m, blasint *n, complex *a, blasint *lda, complex *b,
|
||||
int *ldb, complex *c__, blasint *ldc, float *scale, blasint *info,
|
||||
ftnlen trana_len, ftnlen tranb_len)
|
||||
{
|
||||
/* System generated locals */
|
||||
int a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2,
|
||||
blasint a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2,
|
||||
i__3, i__4;
|
||||
float r__1, r__2;
|
||||
complex q__1, q__2, q__3, q__4;
|
||||
|
|
@ -66,7 +66,7 @@ static int c__1 = 1;
|
|||
void r_cnjg(complex *, complex *);
|
||||
|
||||
/* Local variables */
|
||||
static int j, k, l;
|
||||
static blasint j, k, l;
|
||||
static complex a11;
|
||||
static float db;
|
||||
static complex x11;
|
||||
|
|
@ -75,20 +75,20 @@ static int c__1 = 1;
|
|||
static float dum[1], eps, sgn, smin;
|
||||
static complex suml, sumr;
|
||||
/* Complex */ complex cdotc_(int *, complex *, int
|
||||
*, complex *, int *);
|
||||
extern int lsame_(char *, char *, ftnlen, ftnlen);
|
||||
*, complex *, blasint *);
|
||||
extern blasint lsame_(char *, char *, ftnlen, ftnlen);
|
||||
/* Complex */ complex cdotu_(int *, complex *, int
|
||||
*, complex *, int *);
|
||||
extern /* Subroutine */ int slabad_(float *, float *);
|
||||
extern float clange_(char *, int *, int *, complex *,
|
||||
int *, float *, ftnlen);
|
||||
*, complex *, blasint *);
|
||||
extern /* Subroutine */ blasint slabad_(float *, float *);
|
||||
extern float clange_(char *, blasint *, blasint *, complex *,
|
||||
blasint *, float *, ftnlen);
|
||||
/* Complex */ complex cladiv_(complex *, complex *);
|
||||
static float scaloc;
|
||||
extern float slamch_(char *, ftnlen);
|
||||
extern /* Subroutine */ int csscal_(int *, float *, complex *, int
|
||||
*), xerbla_(char *, int *, ftnlen);
|
||||
extern /* Subroutine */ blasint csscal_(int *, float *, complex *, int
|
||||
*), xerbla_(char *, blasint *, ftnlen);
|
||||
static float bignum;
|
||||
static int notrna, notrnb;
|
||||
static blasint notrna, notrnb;
|
||||
static float smlnum;
|
||||
|
||||
/* Parameter adjustments */
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
#include "relapack.h"
|
||||
|
||||
static void RELAPACK_ctrtri_rec(const char *, const char *, const int *,
|
||||
float *, const int *, int *);
|
||||
static void RELAPACK_ctrtri_rec(const char *, const char *, const blasint *,
|
||||
float *, const blasint *, blasint *);
|
||||
|
||||
|
||||
/** CTRTRI computes the inverse of a complex upper or lower triangular matrix A.
|
||||
|
|
@ -11,16 +11,16 @@ static void RELAPACK_ctrtri_rec(const char *, const char *, const int *,
|
|||
* http://www.netlib.org/lapack/explore-html/df/df8/ctrtri_8f.html
|
||||
* */
|
||||
void RELAPACK_ctrtri(
|
||||
const char *uplo, const char *diag, const int *n,
|
||||
float *A, const int *ldA,
|
||||
int *info
|
||||
const char *uplo, const char *diag, const blasint *n,
|
||||
float *A, const blasint *ldA,
|
||||
blasint *info
|
||||
) {
|
||||
|
||||
// Check arguments
|
||||
const int lower = LAPACK(lsame)(uplo, "L");
|
||||
const int upper = LAPACK(lsame)(uplo, "U");
|
||||
const int nounit = LAPACK(lsame)(diag, "N");
|
||||
const int unit = LAPACK(lsame)(diag, "U");
|
||||
const blasint lower = LAPACK(lsame)(uplo, "L");
|
||||
const blasint upper = LAPACK(lsame)(uplo, "U");
|
||||
const blasint nounit = LAPACK(lsame)(diag, "N");
|
||||
const blasint unit = LAPACK(lsame)(diag, "U");
|
||||
*info = 0;
|
||||
if (!lower && !upper)
|
||||
*info = -1;
|
||||
|
|
@ -31,8 +31,8 @@ void RELAPACK_ctrtri(
|
|||
else if (*ldA < MAX(1, *n))
|
||||
*info = -5;
|
||||
if (*info) {
|
||||
const int minfo = -*info;
|
||||
LAPACK(xerbla)("CTRTRI", &minfo);
|
||||
const blasint minfo = -*info;
|
||||
LAPACK(xerbla)("CTRTRI", &minfo, strlen("CTRTRI"));
|
||||
return;
|
||||
}
|
||||
|
||||
|
|
@ -42,7 +42,7 @@ void RELAPACK_ctrtri(
|
|||
|
||||
// check for singularity
|
||||
if (nounit) {
|
||||
int i;
|
||||
blasint i;
|
||||
for (i = 0; i < *n; i++)
|
||||
if (A[2 * (i + *ldA * i)] == 0 && A[2 * (i + *ldA * i) + 1] == 0) {
|
||||
*info = i;
|
||||
|
|
@ -57,9 +57,9 @@ void RELAPACK_ctrtri(
|
|||
|
||||
/** ctrtri's recursive compute kernel */
|
||||
static void RELAPACK_ctrtri_rec(
|
||||
const char *uplo, const char *diag, const int *n,
|
||||
float *A, const int *ldA,
|
||||
int *info
|
||||
const char *uplo, const char *diag, const blasint *n,
|
||||
float *A, const blasint *ldA,
|
||||
blasint *info
|
||||
){
|
||||
|
||||
if (*n <= MAX(CROSSOVER_CTRTRI, 1)) {
|
||||
|
|
@ -73,8 +73,8 @@ static void RELAPACK_ctrtri_rec(
|
|||
const float MONE[] = { -1., 0. };
|
||||
|
||||
// Splitting
|
||||
const int n1 = CREC_SPLIT(*n);
|
||||
const int n2 = *n - n1;
|
||||
const blasint n1 = CREC_SPLIT(*n);
|
||||
const blasint n2 = *n - n1;
|
||||
|
||||
// A_TL A_TR
|
||||
// A_BL A_BR
|
||||
|
|
|
|||
|
|
@ -1,9 +1,8 @@
|
|||
#include "relapack.h"
|
||||
#include "stdlib.h"
|
||||
|
||||
static void RELAPACK_dgbtrf_rec(const int *, const int *, const int *,
|
||||
const int *, double *, const int *, int *, double *, const int *, double *,
|
||||
const int *, int *);
|
||||
static void RELAPACK_dgbtrf_rec(const blasint *, const blasint *, const blasint *,
|
||||
const blasint *, double *, const blasint *, blasint *, double *, const blasint *, double *,
|
||||
const blasint *, blasint *);
|
||||
|
||||
|
||||
/** DGBTRF computes an LU factorization of a real m-by-n band matrix A using partial pivoting with row interchanges.
|
||||
|
|
@ -13,9 +12,9 @@ static void RELAPACK_dgbtrf_rec(const int *, const int *, const int *,
|
|||
* http://www.netlib.org/lapack/explore-html/da/d87/dgbtrf_8f.html
|
||||
* */
|
||||
void RELAPACK_dgbtrf(
|
||||
const int *m, const int *n, const int *kl, const int *ku,
|
||||
double *Ab, const int *ldAb, int *ipiv,
|
||||
int *info
|
||||
const blasint *m, const blasint *n, const blasint *kl, const blasint *ku,
|
||||
double *Ab, const blasint *ldAb, blasint *ipiv,
|
||||
blasint *info
|
||||
) {
|
||||
|
||||
// Check arguments
|
||||
|
|
@ -31,8 +30,8 @@ void RELAPACK_dgbtrf(
|
|||
else if (*ldAb < 2 * *kl + *ku + 1)
|
||||
*info = -6;
|
||||
if (*info) {
|
||||
const int minfo = -*info;
|
||||
LAPACK(xerbla)("DGBTRF", &minfo);
|
||||
const blasint minfo = -*info;
|
||||
LAPACK(xerbla)("DGBTRF", &minfo, strlen("DGBTRF"));
|
||||
return;
|
||||
}
|
||||
|
||||
|
|
@ -40,14 +39,14 @@ void RELAPACK_dgbtrf(
|
|||
const double ZERO[] = { 0. };
|
||||
|
||||
// Result upper band width
|
||||
const int kv = *ku + *kl;
|
||||
const blasint kv = *ku + *kl;
|
||||
|
||||
// Unskew A
|
||||
const int ldA[] = { *ldAb - 1 };
|
||||
const blasint ldA[] = { *ldAb - 1 };
|
||||
double *const A = Ab + kv;
|
||||
|
||||
// Zero upper diagonal fill-in elements
|
||||
int i, j;
|
||||
blasint i, j;
|
||||
for (j = 0; j < *n; j++) {
|
||||
double *const A_j = A + *ldA * j;
|
||||
for (i = MAX(0, j - kv); i < j - *ku; i++)
|
||||
|
|
@ -55,11 +54,12 @@ void RELAPACK_dgbtrf(
|
|||
}
|
||||
|
||||
// Allocate work space
|
||||
const int n1 = DREC_SPLIT(*n);
|
||||
const int mWorkl = (kv > n1) ? MAX(1, *m - *kl) : kv;
|
||||
const int nWorkl = (kv > n1) ? n1 : kv;
|
||||
const int mWorku = (*kl > n1) ? n1 : *kl;
|
||||
const int nWorku = (*kl > n1) ? MAX(0, *n - *kl) : *kl;
|
||||
const blasint n1 = DREC_SPLIT(*n);
|
||||
const blasint mWorkl = abs( (kv > n1) ? MAX(1, *m - *kl) : kv);
|
||||
const blasint nWorkl = abs( (kv > n1) ? n1 : kv);
|
||||
const blasint mWorku = abs( (*kl > n1) ? n1 : *kl);
|
||||
// const blasint nWorku = abs( (*kl > n1) ? MAX(0, *n - *kl) : *kl);
|
||||
const blasint nWorku = abs( (*kl > n1) ? MAX(1, *n - *kl) : *kl);
|
||||
double *Workl = malloc(mWorkl * nWorkl * sizeof(double));
|
||||
double *Worku = malloc(mWorku * nWorku * sizeof(double));
|
||||
LAPACK(dlaset)("L", &mWorkl, &nWorkl, ZERO, ZERO, Workl, &mWorkl);
|
||||
|
|
@ -76,10 +76,10 @@ void RELAPACK_dgbtrf(
|
|||
|
||||
/** dgbtrf's recursive compute kernel */
|
||||
static void RELAPACK_dgbtrf_rec(
|
||||
const int *m, const int *n, const int *kl, const int *ku,
|
||||
double *Ab, const int *ldAb, int *ipiv,
|
||||
double *Workl, const int *ldWorkl, double *Worku, const int *ldWorku,
|
||||
int *info
|
||||
const blasint *m, const blasint *n, const blasint *kl, const blasint *ku,
|
||||
double *Ab, const blasint *ldAb, blasint *ipiv,
|
||||
double *Workl, const blasint *ldWorkl, double *Worku, const blasint *ldWorku,
|
||||
blasint *info
|
||||
) {
|
||||
|
||||
if (*n <= MAX(CROSSOVER_DGBTRF, 1)) {
|
||||
|
|
@ -91,25 +91,25 @@ static void RELAPACK_dgbtrf_rec(
|
|||
// Constants
|
||||
const double ONE[] = { 1. };
|
||||
const double MONE[] = { -1. };
|
||||
const int iONE[] = { 1 };
|
||||
const blasint iONE[] = { 1 };
|
||||
|
||||
// Loop iterators
|
||||
int i, j;
|
||||
blasint i, j;
|
||||
|
||||
// Output upper band width
|
||||
const int kv = *ku + *kl;
|
||||
const blasint kv = *ku + *kl;
|
||||
|
||||
// Unskew A
|
||||
const int ldA[] = { *ldAb - 1 };
|
||||
const blasint ldA[] = { *ldAb - 1 };
|
||||
double *const A = Ab + kv;
|
||||
|
||||
// Splitting
|
||||
const int n1 = MIN(DREC_SPLIT(*n), *kl);
|
||||
const int n2 = *n - n1;
|
||||
const int m1 = MIN(n1, *m);
|
||||
const int m2 = *m - m1;
|
||||
const int mn1 = MIN(m1, n1);
|
||||
const int mn2 = MIN(m2, n2);
|
||||
const blasint n1 = MIN(DREC_SPLIT(*n), *kl);
|
||||
const blasint n2 = *n - n1;
|
||||
const blasint m1 = MIN(n1, *m);
|
||||
const blasint m2 = *m - m1;
|
||||
const blasint mn1 = MIN(m1, n1);
|
||||
const blasint mn2 = MIN(m2, n2);
|
||||
|
||||
// Ab_L *
|
||||
// Ab_BR
|
||||
|
|
@ -129,14 +129,14 @@ static void RELAPACK_dgbtrf_rec(
|
|||
|
||||
// ipiv_T
|
||||
// ipiv_B
|
||||
int *const ipiv_T = ipiv;
|
||||
int *const ipiv_B = ipiv + n1;
|
||||
blasint *const ipiv_T = ipiv;
|
||||
blasint *const ipiv_B = ipiv + n1;
|
||||
|
||||
// Banded splitting
|
||||
const int n21 = MIN(n2, kv - n1);
|
||||
const int n22 = MIN(n2 - n21, n1);
|
||||
const int m21 = MIN(m2, *kl - m1);
|
||||
const int m22 = MIN(m2 - m21, m1);
|
||||
const blasint n21 = MIN(n2, kv - n1);
|
||||
const blasint n22 = MIN(n2 - n21, n1);
|
||||
const blasint m21 = MIN(m2, *kl - m1);
|
||||
const blasint m22 = MIN(m2 - m21, m1);
|
||||
|
||||
// n1 n21 n22
|
||||
// m * A_Rl ARr
|
||||
|
|
@ -164,7 +164,7 @@ static void RELAPACK_dgbtrf_rec(
|
|||
|
||||
// partially redo swaps in A_L
|
||||
for (i = 0; i < mn1; i++) {
|
||||
const int ip = ipiv_T[i] - 1;
|
||||
const blasint ip = ipiv_T[i] - 1;
|
||||
if (ip != i) {
|
||||
if (ip < *kl)
|
||||
BLAS(dswap)(&i, A_L + i, ldA, A_L + ip, ldA);
|
||||
|
|
@ -180,7 +180,7 @@ static void RELAPACK_dgbtrf_rec(
|
|||
for (j = 0; j < n22; j++) {
|
||||
double *const A_Rrj = A_Rr + *ldA * j;
|
||||
for (i = j; i < mn1; i++) {
|
||||
const int ip = ipiv_T[i] - 1;
|
||||
const blasint ip = ipiv_T[i] - 1;
|
||||
if (ip != i) {
|
||||
const double tmp = A_Rrj[i];
|
||||
A_Rrj[i] = A_Rr[ip];
|
||||
|
|
@ -208,7 +208,7 @@ static void RELAPACK_dgbtrf_rec(
|
|||
|
||||
// partially undo swaps in A_L
|
||||
for (i = mn1 - 1; i >= 0; i--) {
|
||||
const int ip = ipiv_T[i] - 1;
|
||||
const blasint ip = ipiv_T[i] - 1;
|
||||
if (ip != i) {
|
||||
if (ip < *kl)
|
||||
BLAS(dswap)(&i, A_L + i, ldA, A_L + ip, ldA);
|
||||
|
|
|
|||
|
|
@ -1,12 +1,12 @@
|
|||
#include "relapack.h"
|
||||
|
||||
static void RELAPACK_dgemmt_rec(const char *, const char *, const char *,
|
||||
const int *, const int *, const double *, const double *, const int *,
|
||||
const double *, const int *, const double *, double *, const int *);
|
||||
const blasint *, const blasint *, const double *, const double *, const blasint *,
|
||||
const double *, const blasint *, const double *, double *, const blasint *);
|
||||
|
||||
static void RELAPACK_dgemmt_rec2(const char *, const char *, const char *,
|
||||
const int *, const int *, const double *, const double *, const int *,
|
||||
const double *, const int *, const double *, double *, const int *);
|
||||
const blasint *, const blasint *, const double *, const double *, const blasint *,
|
||||
const double *, const blasint *, const double *, double *, const blasint *);
|
||||
|
||||
|
||||
/** DGEMMT computes a matrix-matrix product with general matrices but updates
|
||||
|
|
@ -20,10 +20,10 @@ static void RELAPACK_dgemmt_rec2(const char *, const char *, const char *,
|
|||
* */
|
||||
void RELAPACK_dgemmt(
|
||||
const char *uplo, const char *transA, const char *transB,
|
||||
const int *n, const int *k,
|
||||
const double *alpha, const double *A, const int *ldA,
|
||||
const double *B, const int *ldB,
|
||||
const double *beta, double *C, const int *ldC
|
||||
const blasint *n, const blasint *k,
|
||||
const double *alpha, const double *A, const blasint *ldA,
|
||||
const double *B, const blasint *ldB,
|
||||
const double *beta, double *C, const blasint *ldC
|
||||
) {
|
||||
|
||||
#if HAVE_XGEMMT
|
||||
|
|
@ -32,13 +32,13 @@ void RELAPACK_dgemmt(
|
|||
#else
|
||||
|
||||
// Check arguments
|
||||
const int lower = LAPACK(lsame)(uplo, "L");
|
||||
const int upper = LAPACK(lsame)(uplo, "U");
|
||||
const int notransA = LAPACK(lsame)(transA, "N");
|
||||
const int tranA = LAPACK(lsame)(transA, "T");
|
||||
const int notransB = LAPACK(lsame)(transB, "N");
|
||||
const int tranB = LAPACK(lsame)(transB, "T");
|
||||
int info = 0;
|
||||
const blasint lower = LAPACK(lsame)(uplo, "L");
|
||||
const blasint upper = LAPACK(lsame)(uplo, "U");
|
||||
const blasint notransA = LAPACK(lsame)(transA, "N");
|
||||
const blasint tranA = LAPACK(lsame)(transA, "T");
|
||||
const blasint notransB = LAPACK(lsame)(transB, "N");
|
||||
const blasint tranB = LAPACK(lsame)(transB, "T");
|
||||
blasint info = 0;
|
||||
if (!lower && !upper)
|
||||
info = 1;
|
||||
else if (!tranA && !notransA)
|
||||
|
|
@ -56,7 +56,7 @@ void RELAPACK_dgemmt(
|
|||
else if (*ldC < MAX(1, *n))
|
||||
info = 13;
|
||||
if (info) {
|
||||
LAPACK(xerbla)("DGEMMT", &info);
|
||||
LAPACK(xerbla)("DGEMMT", &info, strlen("DGEMMT"));
|
||||
return;
|
||||
}
|
||||
|
||||
|
|
@ -74,10 +74,10 @@ void RELAPACK_dgemmt(
|
|||
/** dgemmt's recursive compute kernel */
|
||||
static void RELAPACK_dgemmt_rec(
|
||||
const char *uplo, const char *transA, const char *transB,
|
||||
const int *n, const int *k,
|
||||
const double *alpha, const double *A, const int *ldA,
|
||||
const double *B, const int *ldB,
|
||||
const double *beta, double *C, const int *ldC
|
||||
const blasint *n, const blasint *k,
|
||||
const double *alpha, const double *A, const blasint *ldA,
|
||||
const double *B, const blasint *ldB,
|
||||
const double *beta, double *C, const blasint *ldC
|
||||
) {
|
||||
|
||||
if (*n <= MAX(CROSSOVER_DGEMMT, 1)) {
|
||||
|
|
@ -87,8 +87,8 @@ static void RELAPACK_dgemmt_rec(
|
|||
}
|
||||
|
||||
// Splitting
|
||||
const int n1 = DREC_SPLIT(*n);
|
||||
const int n2 = *n - n1;
|
||||
const blasint n1 = DREC_SPLIT(*n);
|
||||
const blasint n2 = *n - n1;
|
||||
|
||||
// A_T
|
||||
// A_B
|
||||
|
|
@ -124,16 +124,16 @@ static void RELAPACK_dgemmt_rec(
|
|||
/** dgemmt's unblocked compute kernel */
|
||||
static void RELAPACK_dgemmt_rec2(
|
||||
const char *uplo, const char *transA, const char *transB,
|
||||
const int *n, const int *k,
|
||||
const double *alpha, const double *A, const int *ldA,
|
||||
const double *B, const int *ldB,
|
||||
const double *beta, double *C, const int *ldC
|
||||
const blasint *n, const blasint *k,
|
||||
const double *alpha, const double *A, const blasint *ldA,
|
||||
const double *B, const blasint *ldB,
|
||||
const double *beta, double *C, const blasint *ldC
|
||||
) {
|
||||
|
||||
const int incB = (*transB == 'N') ? 1 : *ldB;
|
||||
const int incC = 1;
|
||||
const blasint incB = (*transB == 'N') ? 1 : *ldB;
|
||||
const blasint incC = 1;
|
||||
|
||||
int i;
|
||||
blasint i;
|
||||
for (i = 0; i < *n; i++) {
|
||||
// A_0
|
||||
// A_i
|
||||
|
|
@ -149,13 +149,13 @@ static void RELAPACK_dgemmt_rec2(
|
|||
double *const C_ii = C + *ldC * i + i;
|
||||
|
||||
if (*uplo == 'L') {
|
||||
const int nmi = *n - i;
|
||||
const blasint nmi = *n - i;
|
||||
if (*transA == 'N')
|
||||
BLAS(dgemv)(transA, &nmi, k, alpha, A_i, ldA, B_i, &incB, beta, C_ii, &incC);
|
||||
else
|
||||
BLAS(dgemv)(transA, k, &nmi, alpha, A_i, ldA, B_i, &incB, beta, C_ii, &incC);
|
||||
} else {
|
||||
const int ip1 = i + 1;
|
||||
const blasint ip1 = i + 1;
|
||||
if (*transA == 'N')
|
||||
BLAS(dgemv)(transA, &ip1, k, alpha, A_0, ldA, B_i, &incB, beta, C_0i, &incC);
|
||||
else
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
#include "relapack.h"
|
||||
|
||||
static void RELAPACK_dgetrf_rec(const int *, const int *, double *,
|
||||
const int *, int *, int *);
|
||||
static void RELAPACK_dgetrf_rec(const blasint *, const blasint *, double *,
|
||||
const blasint *, blasint *, blasint *);
|
||||
|
||||
|
||||
/** DGETRF computes an LU factorization of a general M-by-N matrix A using partial pivoting with row interchanges.
|
||||
|
|
@ -11,9 +11,9 @@ static void RELAPACK_dgetrf_rec(const int *, const int *, double *,
|
|||
* http://www.netlib.org/lapack/explore-html/d3/d6a/dgetrf_8f.html
|
||||
* */
|
||||
void RELAPACK_dgetrf(
|
||||
const int *m, const int *n,
|
||||
double *A, const int *ldA, int *ipiv,
|
||||
int *info
|
||||
const blasint *m, const blasint *n,
|
||||
double *A, const blasint *ldA, blasint *ipiv,
|
||||
blasint *info
|
||||
) {
|
||||
|
||||
// Check arguments
|
||||
|
|
@ -25,12 +25,12 @@ void RELAPACK_dgetrf(
|
|||
else if (*ldA < MAX(1, *n))
|
||||
*info = -4;
|
||||
if (*info) {
|
||||
const int minfo = -*info;
|
||||
LAPACK(xerbla)("DGETRF", &minfo);
|
||||
const blasint minfo = -*info;
|
||||
LAPACK(xerbla)("DGETRF", &minfo, strlen("DGETRF"));
|
||||
return;
|
||||
}
|
||||
|
||||
const int sn = MIN(*m, *n);
|
||||
const blasint sn = MIN(*m, *n);
|
||||
|
||||
RELAPACK_dgetrf_rec(m, &sn, A, ldA, ipiv, info);
|
||||
|
||||
|
|
@ -38,10 +38,10 @@ void RELAPACK_dgetrf(
|
|||
if (*m < *n) {
|
||||
// Constants
|
||||
const double ONE[] = { 1. };
|
||||
const int iONE[] = { 1. };
|
||||
const blasint iONE[] = { 1. };
|
||||
|
||||
// Splitting
|
||||
const int rn = *n - *m;
|
||||
const blasint rn = *n - *m;
|
||||
|
||||
// A_L A_R
|
||||
const double *const A_L = A;
|
||||
|
|
@ -57,9 +57,9 @@ void RELAPACK_dgetrf(
|
|||
|
||||
/** dgetrf's recursive compute kernel */
|
||||
static void RELAPACK_dgetrf_rec(
|
||||
const int *m, const int *n,
|
||||
double *A, const int *ldA, int *ipiv,
|
||||
int *info
|
||||
const blasint *m, const blasint *n,
|
||||
double *A, const blasint *ldA, blasint *ipiv,
|
||||
blasint *info
|
||||
) {
|
||||
|
||||
if (*n <= MAX(CROSSOVER_DGETRF, 1)) {
|
||||
|
|
@ -71,12 +71,12 @@ static void RELAPACK_dgetrf_rec(
|
|||
// Constants
|
||||
const double ONE[] = { 1. };
|
||||
const double MONE[] = { -1. };
|
||||
const int iONE[] = { 1 };
|
||||
const blasint iONE[] = { 1 };
|
||||
|
||||
// Splitting
|
||||
const int n1 = DREC_SPLIT(*n);
|
||||
const int n2 = *n - n1;
|
||||
const int m2 = *m - n1;
|
||||
const blasint n1 = DREC_SPLIT(*n);
|
||||
const blasint n2 = *n - n1;
|
||||
const blasint m2 = *m - n1;
|
||||
|
||||
// A_L A_R
|
||||
double *const A_L = A;
|
||||
|
|
@ -91,8 +91,8 @@ static void RELAPACK_dgetrf_rec(
|
|||
|
||||
// ipiv_T
|
||||
// ipiv_B
|
||||
int *const ipiv_T = ipiv;
|
||||
int *const ipiv_B = ipiv + n1;
|
||||
blasint *const ipiv_T = ipiv;
|
||||
blasint *const ipiv_B = ipiv + n1;
|
||||
|
||||
// recursion(A_L, ipiv_T)
|
||||
RELAPACK_dgetrf_rec(m, &n1, A_L, ldA, ipiv_T, info);
|
||||
|
|
@ -111,7 +111,7 @@ static void RELAPACK_dgetrf_rec(
|
|||
// apply pivots to A_BL
|
||||
LAPACK(dlaswp)(&n1, A_BL, ldA, iONE, &n2, ipiv_B, iONE);
|
||||
// shift pivots
|
||||
int i;
|
||||
blasint i;
|
||||
for (i = 0; i < n2; i++)
|
||||
ipiv_B[i] += n1;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
#include "relapack.h"
|
||||
|
||||
static void RELAPACK_dlauum_rec(const char *, const int *, double *,
|
||||
const int *, int *);
|
||||
static void RELAPACK_dlauum_rec(const char *, const blasint *, double *,
|
||||
const blasint *, blasint *);
|
||||
|
||||
|
||||
/** DLAUUM computes the product U * U**T or L**T * L, where the triangular factor U or L is stored in the upper or lower triangular part of the array A.
|
||||
|
|
@ -11,14 +11,14 @@ static void RELAPACK_dlauum_rec(const char *, const int *, double *,
|
|||
* http://www.netlib.org/lapack/explore-html/d0/dc2/dlauum_8f.html
|
||||
* */
|
||||
void RELAPACK_dlauum(
|
||||
const char *uplo, const int *n,
|
||||
double *A, const int *ldA,
|
||||
int *info
|
||||
const char *uplo, const blasint *n,
|
||||
double *A, const blasint *ldA,
|
||||
blasint *info
|
||||
) {
|
||||
|
||||
// Check arguments
|
||||
const int lower = LAPACK(lsame)(uplo, "L");
|
||||
const int upper = LAPACK(lsame)(uplo, "U");
|
||||
const blasint lower = LAPACK(lsame)(uplo, "L");
|
||||
const blasint upper = LAPACK(lsame)(uplo, "U");
|
||||
*info = 0;
|
||||
if (!lower && !upper)
|
||||
*info = -1;
|
||||
|
|
@ -27,8 +27,8 @@ void RELAPACK_dlauum(
|
|||
else if (*ldA < MAX(1, *n))
|
||||
*info = -4;
|
||||
if (*info) {
|
||||
const int minfo = -*info;
|
||||
LAPACK(xerbla)("DLAUUM", &minfo);
|
||||
const blasint minfo = -*info;
|
||||
LAPACK(xerbla)("DLAUUM", &minfo, strlen("DLAUUM"));
|
||||
return;
|
||||
}
|
||||
|
||||
|
|
@ -42,9 +42,9 @@ void RELAPACK_dlauum(
|
|||
|
||||
/** dlauum's recursive compute kernel */
|
||||
static void RELAPACK_dlauum_rec(
|
||||
const char *uplo, const int *n,
|
||||
double *A, const int *ldA,
|
||||
int *info
|
||||
const char *uplo, const blasint *n,
|
||||
double *A, const blasint *ldA,
|
||||
blasint *info
|
||||
) {
|
||||
|
||||
if (*n <= MAX(CROSSOVER_DLAUUM, 1)) {
|
||||
|
|
@ -57,8 +57,8 @@ static void RELAPACK_dlauum_rec(
|
|||
const double ONE[] = { 1. };
|
||||
|
||||
// Splitting
|
||||
const int n1 = DREC_SPLIT(*n);
|
||||
const int n2 = *n - n1;
|
||||
const blasint n1 = DREC_SPLIT(*n);
|
||||
const blasint n2 = *n - n1;
|
||||
|
||||
// A_TL A_TR
|
||||
// A_BL A_BR
|
||||
|
|
|
|||
|
|
@ -1,8 +1,8 @@
|
|||
#include "relapack.h"
|
||||
#include "stdlib.h"
|
||||
|
||||
static void RELAPACK_dpbtrf_rec(const char *, const int *, const int *,
|
||||
double *, const int *, double *, const int *, int *);
|
||||
static void RELAPACK_dpbtrf_rec(const char *, const blasint *, const blasint *,
|
||||
double *, const blasint *, double *, const blasint *, blasint *);
|
||||
|
||||
|
||||
/** DPBTRF computes the Cholesky factorization of a real symmetric positive definite band matrix A.
|
||||
|
|
@ -12,14 +12,14 @@ static void RELAPACK_dpbtrf_rec(const char *, const int *, const int *,
|
|||
* http://www.netlib.org/lapack/explore-html/df/da9/dpbtrf_8f.html
|
||||
* */
|
||||
void RELAPACK_dpbtrf(
|
||||
const char *uplo, const int *n, const int *kd,
|
||||
double *Ab, const int *ldAb,
|
||||
int *info
|
||||
const char *uplo, const blasint *n, const blasint *kd,
|
||||
double *Ab, const blasint *ldAb,
|
||||
blasint *info
|
||||
) {
|
||||
|
||||
// Check arguments
|
||||
const int lower = LAPACK(lsame)(uplo, "L");
|
||||
const int upper = LAPACK(lsame)(uplo, "U");
|
||||
const blasint lower = LAPACK(lsame)(uplo, "L");
|
||||
const blasint upper = LAPACK(lsame)(uplo, "U");
|
||||
*info = 0;
|
||||
if (!lower && !upper)
|
||||
*info = -1;
|
||||
|
|
@ -30,8 +30,8 @@ void RELAPACK_dpbtrf(
|
|||
else if (*ldAb < *kd + 1)
|
||||
*info = -5;
|
||||
if (*info) {
|
||||
const int minfo = -*info;
|
||||
LAPACK(xerbla)("DPBTRF", &minfo);
|
||||
const blasint minfo = -*info;
|
||||
LAPACK(xerbla)("DPBTRF", &minfo, strlen("DPBTRF"));
|
||||
return;
|
||||
}
|
||||
|
||||
|
|
@ -42,9 +42,9 @@ void RELAPACK_dpbtrf(
|
|||
const double ZERO[] = { 0. };
|
||||
|
||||
// Allocate work space
|
||||
const int n1 = DREC_SPLIT(*n);
|
||||
const int mWork = (*kd > n1) ? (lower ? *n - *kd : n1) : *kd;
|
||||
const int nWork = (*kd > n1) ? (lower ? n1 : *n - *kd) : *kd;
|
||||
const blasint n1 = DREC_SPLIT(*n);
|
||||
const blasint mWork = (*kd > n1) ? (lower ? *n - *kd : n1) : *kd;
|
||||
const blasint nWork = (*kd > n1) ? (lower ? n1 : *n - *kd) : *kd;
|
||||
double *Work = malloc(mWork * nWork * sizeof(double));
|
||||
LAPACK(dlaset)(uplo, &mWork, &nWork, ZERO, ZERO, Work, &mWork);
|
||||
|
||||
|
|
@ -58,10 +58,10 @@ void RELAPACK_dpbtrf(
|
|||
|
||||
/** dpbtrf's recursive compute kernel */
|
||||
static void RELAPACK_dpbtrf_rec(
|
||||
const char *uplo, const int *n, const int *kd,
|
||||
double *Ab, const int *ldAb,
|
||||
double *Work, const int *ldWork,
|
||||
int *info
|
||||
const char *uplo, const blasint *n, const blasint *kd,
|
||||
double *Ab, const blasint *ldAb,
|
||||
double *Work, const blasint *ldWork,
|
||||
blasint *info
|
||||
){
|
||||
|
||||
if (*n <= MAX(CROSSOVER_DPBTRF, 1)) {
|
||||
|
|
@ -75,12 +75,12 @@ static void RELAPACK_dpbtrf_rec(
|
|||
const double MONE[] = { -1. };
|
||||
|
||||
// Unskew A
|
||||
const int ldA[] = { *ldAb - 1 };
|
||||
const blasint ldA[] = { *ldAb - 1 };
|
||||
double *const A = Ab + ((*uplo == 'L') ? 0 : *kd);
|
||||
|
||||
// Splitting
|
||||
const int n1 = MIN(DREC_SPLIT(*n), *kd);
|
||||
const int n2 = *n - n1;
|
||||
const blasint n1 = MIN(DREC_SPLIT(*n), *kd);
|
||||
const blasint n2 = *n - n1;
|
||||
|
||||
// * *
|
||||
// * Ab_BR
|
||||
|
|
@ -99,8 +99,8 @@ static void RELAPACK_dpbtrf_rec(
|
|||
return;
|
||||
|
||||
// Banded splitting
|
||||
const int n21 = MIN(n2, *kd - n1);
|
||||
const int n22 = MIN(n2 - n21, n1);
|
||||
const blasint n21 = MIN(n2, *kd - n1);
|
||||
const blasint n22 = MIN(n2 - n21, n1);
|
||||
|
||||
// n1 n21 n22
|
||||
// n1 * A_TRl A_TRr
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
#include "relapack.h"
|
||||
|
||||
static void RELAPACK_dpotrf_rec(const char *, const int *, double *,
|
||||
const int *, int *);
|
||||
static void RELAPACK_dpotrf_rec(const char *, const blasint *, double *,
|
||||
const blasint *, blasint *);
|
||||
|
||||
|
||||
/** DPOTRF computes the Cholesky factorization of a real symmetric positive definite matrix A.
|
||||
|
|
@ -11,14 +11,14 @@ static void RELAPACK_dpotrf_rec(const char *, const int *, double *,
|
|||
* http://www.netlib.org/lapack/explore-html/d0/d8a/dpotrf_8f.html
|
||||
* */
|
||||
void RELAPACK_dpotrf(
|
||||
const char *uplo, const int *n,
|
||||
double *A, const int *ldA,
|
||||
int *info
|
||||
const char *uplo, const blasint *n,
|
||||
double *A, const blasint *ldA,
|
||||
blasint *info
|
||||
) {
|
||||
|
||||
// Check arguments
|
||||
const int lower = LAPACK(lsame)(uplo, "L");
|
||||
const int upper = LAPACK(lsame)(uplo, "U");
|
||||
const blasint lower = LAPACK(lsame)(uplo, "L");
|
||||
const blasint upper = LAPACK(lsame)(uplo, "U");
|
||||
*info = 0;
|
||||
if (!lower && !upper)
|
||||
*info = -1;
|
||||
|
|
@ -27,8 +27,8 @@ void RELAPACK_dpotrf(
|
|||
else if (*ldA < MAX(1, *n))
|
||||
*info = -4;
|
||||
if (*info) {
|
||||
const int minfo = -*info;
|
||||
LAPACK(xerbla)("DPOTRF", &minfo);
|
||||
const blasint minfo = -*info;
|
||||
LAPACK(xerbla)("DPOTRF", &minfo, strlen("DPOTRF"));
|
||||
return;
|
||||
}
|
||||
|
||||
|
|
@ -42,9 +42,9 @@ void RELAPACK_dpotrf(
|
|||
|
||||
/** dpotrf's recursive compute kernel */
|
||||
static void RELAPACK_dpotrf_rec(
|
||||
const char *uplo, const int *n,
|
||||
double *A, const int *ldA,
|
||||
int *info
|
||||
const char *uplo, const blasint *n,
|
||||
double *A, const blasint *ldA,
|
||||
blasint *info
|
||||
){
|
||||
|
||||
if (*n <= MAX(CROSSOVER_DPOTRF, 1)) {
|
||||
|
|
@ -58,8 +58,8 @@ static void RELAPACK_dpotrf_rec(
|
|||
const double MONE[] = { -1. };
|
||||
|
||||
// Splitting
|
||||
const int n1 = DREC_SPLIT(*n);
|
||||
const int n2 = *n - n1;
|
||||
const blasint n1 = DREC_SPLIT(*n);
|
||||
const blasint n2 = *n - n1;
|
||||
|
||||
// A_TL A_TR
|
||||
// A_BL A_BR
|
||||
|
|
|
|||
|
|
@ -3,9 +3,9 @@
|
|||
#include "stdlib.h"
|
||||
#endif
|
||||
|
||||
static void RELAPACK_dsygst_rec(const int *, const char *, const int *,
|
||||
double *, const int *, const double *, const int *,
|
||||
double *, const int *, int *);
|
||||
static void RELAPACK_dsygst_rec(const blasint *, const char *, const blasint *,
|
||||
double *, const blasint *, const double *, const blasint *,
|
||||
double *, const blasint *, blasint *);
|
||||
|
||||
|
||||
/** DSYGST reduces a real symmetric-definite generalized eigenproblem to standard form.
|
||||
|
|
@ -15,14 +15,14 @@ static void RELAPACK_dsygst_rec(const int *, const char *, const int *,
|
|||
* http://www.netlib.org/lapack/explore-html/dc/d04/dsygst_8f.html
|
||||
* */
|
||||
void RELAPACK_dsygst(
|
||||
const int *itype, const char *uplo, const int *n,
|
||||
double *A, const int *ldA, const double *B, const int *ldB,
|
||||
int *info
|
||||
const blasint *itype, const char *uplo, const blasint *n,
|
||||
double *A, const blasint *ldA, const double *B, const blasint *ldB,
|
||||
blasint *info
|
||||
) {
|
||||
|
||||
// Check arguments
|
||||
const int lower = LAPACK(lsame)(uplo, "L");
|
||||
const int upper = LAPACK(lsame)(uplo, "U");
|
||||
const blasint lower = LAPACK(lsame)(uplo, "L");
|
||||
const blasint upper = LAPACK(lsame)(uplo, "U");
|
||||
*info = 0;
|
||||
if (*itype < 1 || *itype > 3)
|
||||
*info = -1;
|
||||
|
|
@ -35,8 +35,8 @@ void RELAPACK_dsygst(
|
|||
else if (*ldB < MAX(1, *n))
|
||||
*info = -7;
|
||||
if (*info) {
|
||||
const int minfo = -*info;
|
||||
LAPACK(xerbla)("DSYGST", &minfo);
|
||||
const blasint minfo = -*info;
|
||||
LAPACK(xerbla)("DSYGST", &minfo, strlen("DSYGST"));
|
||||
return;
|
||||
}
|
||||
|
||||
|
|
@ -45,10 +45,10 @@ void RELAPACK_dsygst(
|
|||
|
||||
// Allocate work space
|
||||
double *Work = NULL;
|
||||
int lWork = 0;
|
||||
blasint lWork = 0;
|
||||
#if XSYGST_ALLOW_MALLOC
|
||||
const int n1 = DREC_SPLIT(*n);
|
||||
lWork = n1 * (*n - n1);
|
||||
const blasint n1 = DREC_SPLIT(*n);
|
||||
lWork = abs( n1 * (*n - n1) );
|
||||
Work = malloc(lWork * sizeof(double));
|
||||
if (!Work)
|
||||
lWork = 0;
|
||||
|
|
@ -67,9 +67,9 @@ void RELAPACK_dsygst(
|
|||
|
||||
/** dsygst's recursive compute kernel */
|
||||
static void RELAPACK_dsygst_rec(
|
||||
const int *itype, const char *uplo, const int *n,
|
||||
double *A, const int *ldA, const double *B, const int *ldB,
|
||||
double *Work, const int *lWork, int *info
|
||||
const blasint *itype, const char *uplo, const blasint *n,
|
||||
double *A, const blasint *ldA, const double *B, const blasint *ldB,
|
||||
double *Work, const blasint *lWork, blasint *info
|
||||
) {
|
||||
|
||||
if (*n <= MAX(CROSSOVER_SSYGST, 1)) {
|
||||
|
|
@ -84,14 +84,14 @@ static void RELAPACK_dsygst_rec(
|
|||
const double MONE[] = { -1. };
|
||||
const double HALF[] = { .5 };
|
||||
const double MHALF[] = { -.5 };
|
||||
const int iONE[] = { 1 };
|
||||
const blasint iONE[] = { 1 };
|
||||
|
||||
// Loop iterator
|
||||
int i;
|
||||
blasint i;
|
||||
|
||||
// Splitting
|
||||
const int n1 = DREC_SPLIT(*n);
|
||||
const int n2 = *n - n1;
|
||||
const blasint n1 = DREC_SPLIT(*n);
|
||||
const blasint n2 = *n - n1;
|
||||
|
||||
// A_TL A_TR
|
||||
// A_BL A_BR
|
||||
|
|
|
|||
|
|
@ -3,8 +3,8 @@
|
|||
#include <stdlib.h>
|
||||
#endif
|
||||
|
||||
static void RELAPACK_dsytrf_rec(const char *, const int *, const int *, int *,
|
||||
double *, const int *, int *, double *, const int *, int *);
|
||||
static void RELAPACK_dsytrf_rec(const char *, const blasint *, const blasint *, blasint *,
|
||||
double *, const blasint *, blasint *, double *, const blasint *, blasint *);
|
||||
|
||||
|
||||
/** DSYTRF computes the factorization of a complex symmetric matrix A using the Bunch-Kaufman diagonal pivoting method.
|
||||
|
|
@ -14,21 +14,21 @@ static void RELAPACK_dsytrf_rec(const char *, const int *, const int *, int *,
|
|||
* http://www.netlib.org/lapack/explore-html/dd/df4/dsytrf_8f.html
|
||||
* */
|
||||
void RELAPACK_dsytrf(
|
||||
const char *uplo, const int *n,
|
||||
double *A, const int *ldA, int *ipiv,
|
||||
double *Work, const int *lWork, int *info
|
||||
const char *uplo, const blasint *n,
|
||||
double *A, const blasint *ldA, blasint *ipiv,
|
||||
double *Work, const blasint *lWork, blasint *info
|
||||
) {
|
||||
|
||||
// Required work size
|
||||
const int cleanlWork = *n * (*n / 2);
|
||||
int minlWork = cleanlWork;
|
||||
const blasint cleanlWork = *n * (*n / 2);
|
||||
blasint minlWork = cleanlWork;
|
||||
#if XSYTRF_ALLOW_MALLOC
|
||||
minlWork = 1;
|
||||
#endif
|
||||
|
||||
// Check arguments
|
||||
const int lower = LAPACK(lsame)(uplo, "L");
|
||||
const int upper = LAPACK(lsame)(uplo, "U");
|
||||
const blasint lower = LAPACK(lsame)(uplo, "L");
|
||||
const blasint upper = LAPACK(lsame)(uplo, "U");
|
||||
*info = 0;
|
||||
if (!lower && !upper)
|
||||
*info = -1;
|
||||
|
|
@ -55,8 +55,8 @@ void RELAPACK_dsytrf(
|
|||
#endif
|
||||
|
||||
if (*info) {
|
||||
const int minfo = -*info;
|
||||
LAPACK(xerbla)("DSYTRF", &minfo);
|
||||
const blasint minfo = -*info;
|
||||
LAPACK(xerbla)("DSYTRF", &minfo, strlen("DSYTRF"));
|
||||
return;
|
||||
}
|
||||
|
||||
|
|
@ -64,7 +64,7 @@ void RELAPACK_dsytrf(
|
|||
const char cleanuplo = lower ? 'L' : 'U';
|
||||
|
||||
// Dummy arguments
|
||||
int nout;
|
||||
blasint nout;
|
||||
|
||||
// Recursive kernel
|
||||
RELAPACK_dsytrf_rec(&cleanuplo, n, n, &nout, A, ldA, ipiv, cleanWork, n, info);
|
||||
|
|
@ -78,13 +78,13 @@ void RELAPACK_dsytrf(
|
|||
|
||||
/** dsytrf's recursive compute kernel */
|
||||
static void RELAPACK_dsytrf_rec(
|
||||
const char *uplo, const int *n_full, const int *n, int *n_out,
|
||||
double *A, const int *ldA, int *ipiv,
|
||||
double *Work, const int *ldWork, int *info
|
||||
const char *uplo, const blasint *n_full, const blasint *n, blasint *n_out,
|
||||
double *A, const blasint *ldA, blasint *ipiv,
|
||||
double *Work, const blasint *ldWork, blasint *info
|
||||
) {
|
||||
|
||||
// top recursion level?
|
||||
const int top = *n_full == *n;
|
||||
const blasint top = *n_full == *n;
|
||||
|
||||
if (*n <= MAX(CROSSOVER_DSYTRF, 3)) {
|
||||
// Unblocked
|
||||
|
|
@ -96,34 +96,34 @@ static void RELAPACK_dsytrf_rec(
|
|||
return;
|
||||
}
|
||||
|
||||
int info1, info2;
|
||||
blasint info1, info2;
|
||||
|
||||
// Constants
|
||||
const double ONE[] = { 1. };
|
||||
const double MONE[] = { -1. };
|
||||
const int iONE[] = { 1 };
|
||||
const blasint iONE[] = { 1 };
|
||||
|
||||
// Loop iterator
|
||||
int i;
|
||||
blasint i;
|
||||
|
||||
const int n_rest = *n_full - *n;
|
||||
const blasint n_rest = *n_full - *n;
|
||||
|
||||
if (*uplo == 'L') {
|
||||
// Splitting (setup)
|
||||
int n1 = DREC_SPLIT(*n);
|
||||
int n2 = *n - n1;
|
||||
blasint n1 = DREC_SPLIT(*n);
|
||||
blasint n2 = *n - n1;
|
||||
|
||||
// Work_L *
|
||||
double *const Work_L = Work;
|
||||
|
||||
// recursion(A_L)
|
||||
int n1_out;
|
||||
blasint n1_out;
|
||||
RELAPACK_dsytrf_rec(uplo, n_full, &n1, &n1_out, A, ldA, ipiv, Work_L, ldWork, &info1);
|
||||
n1 = n1_out;
|
||||
|
||||
// Splitting (continued)
|
||||
n2 = *n - n1;
|
||||
const int n_full2 = *n_full - n1;
|
||||
const blasint n_full2 = *n_full - n1;
|
||||
|
||||
// * *
|
||||
// A_BL A_BR
|
||||
|
|
@ -139,23 +139,23 @@ static void RELAPACK_dsytrf_rec(
|
|||
// (top recursion level: use Work as Work_BR)
|
||||
double *const Work_BL = Work + n1;
|
||||
double *const Work_BR = top ? Work : Work + *ldWork * n1 + n1;
|
||||
const int ldWork_BR = top ? n2 : *ldWork;
|
||||
const blasint ldWork_BR = top ? n2 : *ldWork;
|
||||
|
||||
// ipiv_T
|
||||
// ipiv_B
|
||||
int *const ipiv_B = ipiv + n1;
|
||||
blasint *const ipiv_B = ipiv + n1;
|
||||
|
||||
// A_BR = A_BR - A_BL Work_BL'
|
||||
RELAPACK_dgemmt(uplo, "N", "T", &n2, &n1, MONE, A_BL, ldA, Work_BL, ldWork, ONE, A_BR, ldA);
|
||||
BLAS(dgemm)("N", "T", &n_rest, &n2, &n1, MONE, A_BL_B, ldA, Work_BL, ldWork, ONE, A_BR_B, ldA);
|
||||
|
||||
// recursion(A_BR)
|
||||
int n2_out;
|
||||
blasint n2_out;
|
||||
RELAPACK_dsytrf_rec(uplo, &n_full2, &n2, &n2_out, A_BR, ldA, ipiv_B, Work_BR, &ldWork_BR, &info2);
|
||||
|
||||
if (n2_out != n2) {
|
||||
// undo 1 column of updates
|
||||
const int n_restp1 = n_rest + 1;
|
||||
const blasint n_restp1 = n_rest + 1;
|
||||
|
||||
// last column of A_BR
|
||||
double *const A_BR_r = A_BR + *ldA * n2_out + n2_out;
|
||||
|
|
@ -182,22 +182,22 @@ static void RELAPACK_dsytrf_rec(
|
|||
*n_out = n1 + n2;
|
||||
} else {
|
||||
// Splitting (setup)
|
||||
int n2 = DREC_SPLIT(*n);
|
||||
int n1 = *n - n2;
|
||||
blasint n2 = DREC_SPLIT(*n);
|
||||
blasint n1 = *n - n2;
|
||||
|
||||
// * Work_R
|
||||
// (top recursion level: use Work as Work_R)
|
||||
double *const Work_R = top ? Work : Work + *ldWork * n1;
|
||||
|
||||
// recursion(A_R)
|
||||
int n2_out;
|
||||
blasint n2_out;
|
||||
RELAPACK_dsytrf_rec(uplo, n_full, &n2, &n2_out, A, ldA, ipiv, Work_R, ldWork, &info2);
|
||||
const int n2_diff = n2 - n2_out;
|
||||
const blasint n2_diff = n2 - n2_out;
|
||||
n2 = n2_out;
|
||||
|
||||
// Splitting (continued)
|
||||
n1 = *n - n2;
|
||||
const int n_full1 = *n_full - n2;
|
||||
const blasint n_full1 = *n_full - n2;
|
||||
|
||||
// * A_TL_T A_TR_T
|
||||
// * A_TL A_TR
|
||||
|
|
@ -213,19 +213,19 @@ static void RELAPACK_dsytrf_rec(
|
|||
// (top recursion level: Work_R was Work)
|
||||
double *const Work_L = Work;
|
||||
double *const Work_TR = Work + *ldWork * (top ? n2_diff : n1) + n_rest;
|
||||
const int ldWork_L = top ? n1 : *ldWork;
|
||||
const blasint ldWork_L = top ? n1 : *ldWork;
|
||||
|
||||
// A_TL = A_TL - A_TR Work_TR'
|
||||
RELAPACK_dgemmt(uplo, "N", "T", &n1, &n2, MONE, A_TR, ldA, Work_TR, ldWork, ONE, A_TL, ldA);
|
||||
BLAS(dgemm)("N", "T", &n_rest, &n1, &n2, MONE, A_TR_T, ldA, Work_TR, ldWork, ONE, A_TL_T, ldA);
|
||||
|
||||
// recursion(A_TL)
|
||||
int n1_out;
|
||||
blasint n1_out;
|
||||
RELAPACK_dsytrf_rec(uplo, &n_full1, &n1, &n1_out, A, ldA, ipiv, Work_L, &ldWork_L, &info1);
|
||||
|
||||
if (n1_out != n1) {
|
||||
// undo 1 column of updates
|
||||
const int n_restp1 = n_rest + 1;
|
||||
const blasint n_restp1 = n_rest + 1;
|
||||
|
||||
// A_TL_T_l = A_TL_T_l + A_TR_T Work_TR_t'
|
||||
BLAS(dgemv)("N", &n_restp1, &n2, ONE, A_TR_T, ldA, Work_TR, ldWork, ONE, A_TL_T, iONE);
|
||||
|
|
|
|||
|
|
@ -14,7 +14,7 @@
|
|||
|
||||
/* Table of constant values */
|
||||
|
||||
static int c__1 = 1;
|
||||
static blasint c__1 = 1;
|
||||
static double c_b8 = -1.;
|
||||
static double c_b9 = 1.;
|
||||
|
||||
|
|
@ -25,33 +25,33 @@ static double c_b9 = 1.;
|
|||
* The blocked BLAS Level 3 updates were removed and moved to the
|
||||
* recursive algorithm.
|
||||
* */
|
||||
/* Subroutine */ void RELAPACK_dsytrf_rec2(char *uplo, int *n, int *
|
||||
nb, int *kb, double *a, int *lda, int *ipiv,
|
||||
double *w, int *ldw, int *info, ftnlen uplo_len)
|
||||
/* Subroutine */ void RELAPACK_dsytrf_rec2(char *uplo, blasint *n, blasint *
|
||||
nb, blasint *kb, double *a, blasint *lda, blasint *ipiv,
|
||||
double *w, blasint *ldw, blasint *info, ftnlen uplo_len)
|
||||
{
|
||||
/* System generated locals */
|
||||
int a_dim1, a_offset, w_dim1, w_offset, i__1, i__2;
|
||||
blasint a_dim1, a_offset, w_dim1, w_offset, i__1, i__2;
|
||||
double d__1, d__2, d__3;
|
||||
|
||||
/* Builtin functions */
|
||||
double sqrt(double);
|
||||
|
||||
/* Local variables */
|
||||
static int j, k;
|
||||
static blasint j, k;
|
||||
static double t, r1, d11, d21, d22;
|
||||
static int jj, kk, jp, kp, kw, kkw, imax, jmax;
|
||||
static blasint jj, kk, jp, kp, kw, kkw, imax, jmax;
|
||||
static double alpha;
|
||||
extern /* Subroutine */ int dscal_(int *, double *, double *,
|
||||
int *);
|
||||
extern /* Subroutine */ blasint dscal_(int *, double *, double *,
|
||||
blasint *);
|
||||
extern logical lsame_(char *, char *, ftnlen, ftnlen);
|
||||
extern /* Subroutine */ int dgemv_(char *, int *, int *,
|
||||
double *, double *, int *, double *, int *,
|
||||
double *, double *, int *, ftnlen), dcopy_(int *,
|
||||
double *, int *, double *, int *), dswap_(int
|
||||
*, double *, int *, double *, int *);
|
||||
static int kstep;
|
||||
extern /* Subroutine */ blasint dgemv_(char *, blasint *, blasint *,
|
||||
double *, double *, blasint *, double *, blasint *,
|
||||
double *, double *, blasint *, ftnlen), dcopy_(int *,
|
||||
double *, blasint *, double *, blasint *), dswap_(int
|
||||
*, double *, blasint *, double *, blasint *);
|
||||
static blasint kstep;
|
||||
static double absakk;
|
||||
extern int idamax_(int *, double *, int *);
|
||||
extern blasint idamax_(int *, double *, blasint *);
|
||||
static double colmax, rowmax;
|
||||
|
||||
/* Parameter adjustments */
|
||||
|
|
|
|||
|
|
@ -3,8 +3,8 @@
|
|||
#include <stdlib.h>
|
||||
#endif
|
||||
|
||||
static void RELAPACK_dsytrf_rook_rec(const char *, const int *, const int *, int *,
|
||||
double *, const int *, int *, double *, const int *, int *);
|
||||
static void RELAPACK_dsytrf_rook_rec(const char *, const blasint *, const blasint *, blasint *,
|
||||
double *, const blasint *, blasint *, double *, const blasint *, blasint *);
|
||||
|
||||
|
||||
/** DSYTRF_ROOK computes the factorization of a real symmetric matrix A using the bounded Bunch-Kaufman ("rook") diagonal pivoting method.
|
||||
|
|
@ -14,21 +14,21 @@ static void RELAPACK_dsytrf_rook_rec(const char *, const int *, const int *, int
|
|||
* http://www.netlib.org/lapack/explore-html/db/df4/dsytrf__rook_8f.html
|
||||
* */
|
||||
void RELAPACK_dsytrf_rook(
|
||||
const char *uplo, const int *n,
|
||||
double *A, const int *ldA, int *ipiv,
|
||||
double *Work, const int *lWork, int *info
|
||||
const char *uplo, const blasint *n,
|
||||
double *A, const blasint *ldA, blasint *ipiv,
|
||||
double *Work, const blasint *lWork, blasint *info
|
||||
) {
|
||||
|
||||
// Required work size
|
||||
const int cleanlWork = *n * (*n / 2);
|
||||
int minlWork = cleanlWork;
|
||||
const blasint cleanlWork = *n * (*n / 2);
|
||||
blasint minlWork = cleanlWork;
|
||||
#if XSYTRF_ALLOW_MALLOC
|
||||
minlWork = 1;
|
||||
#endif
|
||||
|
||||
// Check arguments
|
||||
const int lower = LAPACK(lsame)(uplo, "L");
|
||||
const int upper = LAPACK(lsame)(uplo, "U");
|
||||
const blasint lower = LAPACK(lsame)(uplo, "L");
|
||||
const blasint upper = LAPACK(lsame)(uplo, "U");
|
||||
*info = 0;
|
||||
if (!lower && !upper)
|
||||
*info = -1;
|
||||
|
|
@ -55,8 +55,8 @@ void RELAPACK_dsytrf_rook(
|
|||
#endif
|
||||
|
||||
if (*info) {
|
||||
const int minfo = -*info;
|
||||
LAPACK(xerbla)("DSYTRF", &minfo);
|
||||
const blasint minfo = -*info;
|
||||
LAPACK(xerbla)("DSYTRF", &minfo, strlen("DSYTRF"));
|
||||
return;
|
||||
}
|
||||
|
||||
|
|
@ -64,7 +64,7 @@ void RELAPACK_dsytrf_rook(
|
|||
const char cleanuplo = lower ? 'L' : 'U';
|
||||
|
||||
// Dummy argument
|
||||
int nout;
|
||||
blasint nout;
|
||||
|
||||
// Recursive kernel
|
||||
RELAPACK_dsytrf_rook_rec(&cleanuplo, n, n, &nout, A, ldA, ipiv, cleanWork, n, info);
|
||||
|
|
@ -78,13 +78,13 @@ void RELAPACK_dsytrf_rook(
|
|||
|
||||
/** dsytrf_rook's recursive compute kernel */
|
||||
static void RELAPACK_dsytrf_rook_rec(
|
||||
const char *uplo, const int *n_full, const int *n, int *n_out,
|
||||
double *A, const int *ldA, int *ipiv,
|
||||
double *Work, const int *ldWork, int *info
|
||||
const char *uplo, const blasint *n_full, const blasint *n, blasint *n_out,
|
||||
double *A, const blasint *ldA, blasint *ipiv,
|
||||
double *Work, const blasint *ldWork, blasint *info
|
||||
) {
|
||||
|
||||
// top recursion level?
|
||||
const int top = *n_full == *n;
|
||||
const blasint top = *n_full == *n;
|
||||
|
||||
if (*n <= MAX(CROSSOVER_DSYTRF_ROOK, 3)) {
|
||||
// Unblocked
|
||||
|
|
@ -96,31 +96,31 @@ static void RELAPACK_dsytrf_rook_rec(
|
|||
return;
|
||||
}
|
||||
|
||||
int info1, info2;
|
||||
blasint info1, info2;
|
||||
|
||||
// Constants
|
||||
const double ONE[] = { 1. };
|
||||
const double MONE[] = { -1. };
|
||||
const int iONE[] = { 1 };
|
||||
const blasint iONE[] = { 1 };
|
||||
|
||||
const int n_rest = *n_full - *n;
|
||||
const blasint n_rest = *n_full - *n;
|
||||
|
||||
if (*uplo == 'L') {
|
||||
// Splitting (setup)
|
||||
int n1 = DREC_SPLIT(*n);
|
||||
int n2 = *n - n1;
|
||||
blasint n1 = DREC_SPLIT(*n);
|
||||
blasint n2 = *n - n1;
|
||||
|
||||
// Work_L *
|
||||
double *const Work_L = Work;
|
||||
|
||||
// recursion(A_L)
|
||||
int n1_out;
|
||||
blasint n1_out;
|
||||
RELAPACK_dsytrf_rook_rec(uplo, n_full, &n1, &n1_out, A, ldA, ipiv, Work_L, ldWork, &info1);
|
||||
n1 = n1_out;
|
||||
|
||||
// Splitting (continued)
|
||||
n2 = *n - n1;
|
||||
const int n_full2 = *n_full - n1;
|
||||
const blasint n_full2 = *n_full - n1;
|
||||
|
||||
// * *
|
||||
// A_BL A_BR
|
||||
|
|
@ -136,23 +136,23 @@ static void RELAPACK_dsytrf_rook_rec(
|
|||
// (top recursion level: use Work as Work_BR)
|
||||
double *const Work_BL = Work + n1;
|
||||
double *const Work_BR = top ? Work : Work + *ldWork * n1 + n1;
|
||||
const int ldWork_BR = top ? n2 : *ldWork;
|
||||
const blasint ldWork_BR = top ? n2 : *ldWork;
|
||||
|
||||
// ipiv_T
|
||||
// ipiv_B
|
||||
int *const ipiv_B = ipiv + n1;
|
||||
blasint *const ipiv_B = ipiv + n1;
|
||||
|
||||
// A_BR = A_BR - A_BL Work_BL'
|
||||
RELAPACK_dgemmt(uplo, "N", "T", &n2, &n1, MONE, A_BL, ldA, Work_BL, ldWork, ONE, A_BR, ldA);
|
||||
BLAS(dgemm)("N", "T", &n_rest, &n2, &n1, MONE, A_BL_B, ldA, Work_BL, ldWork, ONE, A_BR_B, ldA);
|
||||
|
||||
// recursion(A_BR)
|
||||
int n2_out;
|
||||
blasint n2_out;
|
||||
RELAPACK_dsytrf_rook_rec(uplo, &n_full2, &n2, &n2_out, A_BR, ldA, ipiv_B, Work_BR, &ldWork_BR, &info2);
|
||||
|
||||
if (n2_out != n2) {
|
||||
// undo 1 column of updates
|
||||
const int n_restp1 = n_rest + 1;
|
||||
const blasint n_restp1 = n_rest + 1;
|
||||
|
||||
// last column of A_BR
|
||||
double *const A_BR_r = A_BR + *ldA * n2_out + n2_out;
|
||||
|
|
@ -169,7 +169,7 @@ static void RELAPACK_dsytrf_rook_rec(
|
|||
n2 = n2_out;
|
||||
|
||||
// shift pivots
|
||||
int i;
|
||||
blasint i;
|
||||
for (i = 0; i < n2; i++)
|
||||
if (ipiv_B[i] > 0)
|
||||
ipiv_B[i] += n1;
|
||||
|
|
@ -180,22 +180,22 @@ static void RELAPACK_dsytrf_rook_rec(
|
|||
*n_out = n1 + n2;
|
||||
} else {
|
||||
// Splitting (setup)
|
||||
int n2 = DREC_SPLIT(*n);
|
||||
int n1 = *n - n2;
|
||||
blasint n2 = DREC_SPLIT(*n);
|
||||
blasint n1 = *n - n2;
|
||||
|
||||
// * Work_R
|
||||
// (top recursion level: use Work as Work_R)
|
||||
double *const Work_R = top ? Work : Work + *ldWork * n1;
|
||||
|
||||
// recursion(A_R)
|
||||
int n2_out;
|
||||
blasint n2_out;
|
||||
RELAPACK_dsytrf_rook_rec(uplo, n_full, &n2, &n2_out, A, ldA, ipiv, Work_R, ldWork, &info2);
|
||||
const int n2_diff = n2 - n2_out;
|
||||
const blasint n2_diff = n2 - n2_out;
|
||||
n2 = n2_out;
|
||||
|
||||
// Splitting (continued)
|
||||
n1 = *n - n2;
|
||||
const int n_full1 = *n_full - n2;
|
||||
const blasint n_full1 = *n_full - n2;
|
||||
|
||||
// * A_TL_T A_TR_T
|
||||
// * A_TL A_TR
|
||||
|
|
@ -211,19 +211,19 @@ static void RELAPACK_dsytrf_rook_rec(
|
|||
// (top recursion level: Work_R was Work)
|
||||
double *const Work_L = Work;
|
||||
double *const Work_TR = Work + *ldWork * (top ? n2_diff : n1) + n_rest;
|
||||
const int ldWork_L = top ? n1 : *ldWork;
|
||||
const blasint ldWork_L = top ? n1 : *ldWork;
|
||||
|
||||
// A_TL = A_TL - A_TR Work_TR'
|
||||
RELAPACK_dgemmt(uplo, "N", "T", &n1, &n2, MONE, A_TR, ldA, Work_TR, ldWork, ONE, A_TL, ldA);
|
||||
BLAS(dgemm)("N", "T", &n_rest, &n1, &n2, MONE, A_TR_T, ldA, Work_TR, ldWork, ONE, A_TL_T, ldA);
|
||||
|
||||
// recursion(A_TL)
|
||||
int n1_out;
|
||||
blasint n1_out;
|
||||
RELAPACK_dsytrf_rook_rec(uplo, &n_full1, &n1, &n1_out, A, ldA, ipiv, Work_L, &ldWork_L, &info1);
|
||||
|
||||
if (n1_out != n1) {
|
||||
// undo 1 column of updates
|
||||
const int n_restp1 = n_rest + 1;
|
||||
const blasint n_restp1 = n_rest + 1;
|
||||
|
||||
// A_TL_T_l = A_TL_T_l + A_TR_T Work_TR_t'
|
||||
BLAS(dgemv)("N", &n_restp1, &n2, ONE, A_TR_T, ldA, Work_TR, ldWork, ONE, A_TL_T, iONE);
|
||||
|
|
|
|||
|
|
@ -14,7 +14,7 @@
|
|||
|
||||
/* Table of constant values */
|
||||
|
||||
static int c__1 = 1;
|
||||
static blasint c__1 = 1;
|
||||
static double c_b9 = -1.;
|
||||
static double c_b10 = 1.;
|
||||
|
||||
|
|
@ -25,39 +25,39 @@ static double c_b10 = 1.;
|
|||
* The blocked BLAS Level 3 updates were removed and moved to the
|
||||
* recursive algorithm.
|
||||
* */
|
||||
/* Subroutine */ void RELAPACK_dsytrf_rook_rec2(char *uplo, int *n,
|
||||
int *nb, int *kb, double *a, int *lda, int *ipiv,
|
||||
double *w, int *ldw, int *info, ftnlen uplo_len)
|
||||
/* Subroutine */ void RELAPACK_dsytrf_rook_rec2(char *uplo, blasint *n,
|
||||
int *nb, blasint *kb, double *a, blasint *lda, blasint *ipiv,
|
||||
double *w, blasint *ldw, blasint *info, ftnlen uplo_len)
|
||||
{
|
||||
/* System generated locals */
|
||||
int a_dim1, a_offset, w_dim1, w_offset, i__1, i__2;
|
||||
blasint a_dim1, a_offset, w_dim1, w_offset, i__1, i__2;
|
||||
double d__1;
|
||||
|
||||
/* Builtin functions */
|
||||
double sqrt(double);
|
||||
|
||||
/* Local variables */
|
||||
static int j, k, p;
|
||||
static blasint j, k, p;
|
||||
static double t, r1, d11, d12, d21, d22;
|
||||
static int ii, jj, kk, kp, kw, jp1, jp2, kkw;
|
||||
static blasint ii, jj, kk, kp, kw, jp1, jp2, kkw;
|
||||
static logical done;
|
||||
static int imax, jmax;
|
||||
static blasint imax, jmax;
|
||||
static double alpha;
|
||||
extern /* Subroutine */ int dscal_(int *, double *, double *,
|
||||
int *);
|
||||
extern /* Subroutine */ blasint dscal_(int *, double *, double *,
|
||||
blasint *);
|
||||
extern logical lsame_(char *, char *, ftnlen, ftnlen);
|
||||
extern /* Subroutine */ int dgemv_(char *, int *, int *,
|
||||
double *, double *, int *, double *, int *,
|
||||
double *, double *, int *, ftnlen);
|
||||
extern /* Subroutine */ blasint dgemv_(char *, blasint *, blasint *,
|
||||
double *, double *, blasint *, double *, blasint *,
|
||||
double *, double *, blasint *, ftnlen);
|
||||
static double dtemp, sfmin;
|
||||
static int itemp;
|
||||
extern /* Subroutine */ int dcopy_(int *, double *, int *,
|
||||
double *, int *), dswap_(int *, double *, int
|
||||
*, double *, int *);
|
||||
static int kstep;
|
||||
static blasint itemp;
|
||||
extern /* Subroutine */ blasint dcopy_(int *, double *, blasint *,
|
||||
double *, blasint *), dswap_(int *, double *, int
|
||||
*, double *, blasint *);
|
||||
static blasint kstep;
|
||||
extern double dlamch_(char *, ftnlen);
|
||||
static double absakk;
|
||||
extern int idamax_(int *, double *, int *);
|
||||
extern blasint idamax_(int *, double *, blasint *);
|
||||
static double colmax, rowmax;
|
||||
|
||||
/* Parameter adjustments */
|
||||
|
|
|
|||
|
|
@ -1,11 +1,11 @@
|
|||
#include "relapack.h"
|
||||
#include <math.h>
|
||||
|
||||
static void RELAPACK_dtgsyl_rec(const char *, const int *, const int *,
|
||||
const int *, const double *, const int *, const double *, const int *,
|
||||
double *, const int *, const double *, const int *, const double *,
|
||||
const int *, double *, const int *, double *, double *, double *, int *,
|
||||
int *, int *);
|
||||
static void RELAPACK_dtgsyl_rec(const char *, const blasint *, const blasint *,
|
||||
const blasint *, const double *, const blasint *, const double *, const blasint *,
|
||||
double *, const blasint *, const double *, const blasint *, const double *,
|
||||
const blasint *, double *, const blasint *, double *, double *, double *, blasint *,
|
||||
blasint *, blasint *);
|
||||
|
||||
|
||||
/** DTGSYL solves the generalized Sylvester equation.
|
||||
|
|
@ -15,21 +15,21 @@ static void RELAPACK_dtgsyl_rec(const char *, const int *, const int *,
|
|||
* http://www.netlib.org/lapack/explore-html/db/d88/dtgsyl_8f.html
|
||||
* */
|
||||
void RELAPACK_dtgsyl(
|
||||
const char *trans, const int *ijob, const int *m, const int *n,
|
||||
const double *A, const int *ldA, const double *B, const int *ldB,
|
||||
double *C, const int *ldC,
|
||||
const double *D, const int *ldD, const double *E, const int *ldE,
|
||||
double *F, const int *ldF,
|
||||
const char *trans, const blasint *ijob, const blasint *m, const blasint *n,
|
||||
const double *A, const blasint *ldA, const double *B, const blasint *ldB,
|
||||
double *C, const blasint *ldC,
|
||||
const double *D, const blasint *ldD, const double *E, const blasint *ldE,
|
||||
double *F, const blasint *ldF,
|
||||
double *scale, double *dif,
|
||||
double *Work, const int *lWork, int *iWork, int *info
|
||||
double *Work, const blasint *lWork, blasint *iWork, blasint *info
|
||||
) {
|
||||
|
||||
// Parse arguments
|
||||
const int notran = LAPACK(lsame)(trans, "N");
|
||||
const int tran = LAPACK(lsame)(trans, "T");
|
||||
const blasint notran = LAPACK(lsame)(trans, "N");
|
||||
const blasint tran = LAPACK(lsame)(trans, "T");
|
||||
|
||||
// Compute work buffer size
|
||||
int lwmin = 1;
|
||||
blasint lwmin = 1;
|
||||
if (notran && (*ijob == 1 || *ijob == 2))
|
||||
lwmin = MAX(1, 2 * *m * *n);
|
||||
*info = 0;
|
||||
|
|
@ -58,8 +58,8 @@ void RELAPACK_dtgsyl(
|
|||
else if (*lWork < lwmin && *lWork != -1)
|
||||
*info = -20;
|
||||
if (*info) {
|
||||
const int minfo = -*info;
|
||||
LAPACK(xerbla)("DTGSYL", &minfo);
|
||||
const blasint minfo = -*info;
|
||||
LAPACK(xerbla)("DTGSYL", &minfo, strlen("DTGSYL"));
|
||||
return;
|
||||
}
|
||||
|
||||
|
|
@ -75,8 +75,8 @@ void RELAPACK_dtgsyl(
|
|||
// Constant
|
||||
const double ZERO[] = { 0. };
|
||||
|
||||
int isolve = 1;
|
||||
int ifunc = 0;
|
||||
blasint isolve = 1;
|
||||
blasint ifunc = 0;
|
||||
if (notran) {
|
||||
if (*ijob >= 3) {
|
||||
ifunc = *ijob - 2;
|
||||
|
|
@ -87,12 +87,12 @@ void RELAPACK_dtgsyl(
|
|||
}
|
||||
|
||||
double scale2;
|
||||
int iround;
|
||||
blasint iround;
|
||||
for (iround = 1; iround <= isolve; iround++) {
|
||||
*scale = 1;
|
||||
double dscale = 0;
|
||||
double dsum = 1;
|
||||
int pq;
|
||||
blasint pq;
|
||||
RELAPACK_dtgsyl_rec(&cleantrans, &ifunc, m, n, A, ldA, B, ldB, C, ldC, D, ldD, E, ldE, F, ldF, scale, &dsum, &dscale, iWork, &pq, info);
|
||||
if (dscale != 0) {
|
||||
if (*ijob == 1 || *ijob == 3)
|
||||
|
|
@ -121,13 +121,13 @@ void RELAPACK_dtgsyl(
|
|||
|
||||
/** dtgsyl's recursive vompute kernel */
|
||||
static void RELAPACK_dtgsyl_rec(
|
||||
const char *trans, const int *ifunc, const int *m, const int *n,
|
||||
const double *A, const int *ldA, const double *B, const int *ldB,
|
||||
double *C, const int *ldC,
|
||||
const double *D, const int *ldD, const double *E, const int *ldE,
|
||||
double *F, const int *ldF,
|
||||
const char *trans, const blasint *ifunc, const blasint *m, const blasint *n,
|
||||
const double *A, const blasint *ldA, const double *B, const blasint *ldB,
|
||||
double *C, const blasint *ldC,
|
||||
const double *D, const blasint *ldD, const double *E, const blasint *ldE,
|
||||
double *F, const blasint *ldF,
|
||||
double *scale, double *dsum, double *dscale,
|
||||
int *iWork, int *pq, int *info
|
||||
blasint *iWork, blasint *pq, blasint *info
|
||||
) {
|
||||
|
||||
if (*m <= MAX(CROSSOVER_DTGSYL, 1) && *n <= MAX(CROSSOVER_DTGSYL, 1)) {
|
||||
|
|
@ -139,20 +139,20 @@ static void RELAPACK_dtgsyl_rec(
|
|||
// Constants
|
||||
const double ONE[] = { 1. };
|
||||
const double MONE[] = { -1. };
|
||||
const int iONE[] = { 1 };
|
||||
const blasint iONE[] = { 1 };
|
||||
|
||||
// Outputs
|
||||
double scale1[] = { 1. };
|
||||
double scale2[] = { 1. };
|
||||
int info1[] = { 0 };
|
||||
int info2[] = { 0 };
|
||||
blasint info1[] = { 0 };
|
||||
blasint info2[] = { 0 };
|
||||
|
||||
if (*m > *n) {
|
||||
// Splitting
|
||||
int m1 = DREC_SPLIT(*m);
|
||||
blasint m1 = DREC_SPLIT(*m);
|
||||
if (A[m1 + *ldA * (m1 - 1)])
|
||||
m1++;
|
||||
const int m2 = *m - m1;
|
||||
const blasint m2 = *m - m1;
|
||||
|
||||
// A_TL A_TR
|
||||
// 0 A_BR
|
||||
|
|
@ -210,10 +210,10 @@ static void RELAPACK_dtgsyl_rec(
|
|||
}
|
||||
} else {
|
||||
// Splitting
|
||||
int n1 = DREC_SPLIT(*n);
|
||||
blasint n1 = DREC_SPLIT(*n);
|
||||
if (B[n1 + *ldB * (n1 - 1)])
|
||||
n1++;
|
||||
const int n2 = *n - n1;
|
||||
const blasint n2 = *n - n1;
|
||||
|
||||
// B_TL B_TR
|
||||
// 0 B_BR
|
||||
|
|
|
|||
|
|
@ -1,8 +1,8 @@
|
|||
#include "relapack.h"
|
||||
|
||||
static void RELAPACK_dtrsyl_rec(const char *, const char *, const int *,
|
||||
const int *, const int *, const double *, const int *, const double *,
|
||||
const int *, double *, const int *, double *, int *);
|
||||
static void RELAPACK_dtrsyl_rec(const char *, const char *, const blasint *,
|
||||
const blasint *, const blasint *, const double *, const blasint *, const double *,
|
||||
const blasint *, double *, const blasint *, double *, blasint *);
|
||||
|
||||
|
||||
/** DTRSYL solves the real Sylvester matrix equation.
|
||||
|
|
@ -12,20 +12,20 @@ static void RELAPACK_dtrsyl_rec(const char *, const char *, const int *,
|
|||
* http://www.netlib.org/lapack/explore-html/d6/d43/dtrsyl_8f.html
|
||||
* */
|
||||
void RELAPACK_dtrsyl(
|
||||
const char *tranA, const char *tranB, const int *isgn,
|
||||
const int *m, const int *n,
|
||||
const double *A, const int *ldA, const double *B, const int *ldB,
|
||||
double *C, const int *ldC, double *scale,
|
||||
int *info
|
||||
const char *tranA, const char *tranB, const blasint *isgn,
|
||||
const blasint *m, const blasint *n,
|
||||
const double *A, const blasint *ldA, const double *B, const blasint *ldB,
|
||||
double *C, const blasint *ldC, double *scale,
|
||||
blasint *info
|
||||
) {
|
||||
|
||||
// Check arguments
|
||||
const int notransA = LAPACK(lsame)(tranA, "N");
|
||||
const int transA = LAPACK(lsame)(tranA, "T");
|
||||
const int ctransA = LAPACK(lsame)(tranA, "C");
|
||||
const int notransB = LAPACK(lsame)(tranB, "N");
|
||||
const int transB = LAPACK(lsame)(tranB, "T");
|
||||
const int ctransB = LAPACK(lsame)(tranB, "C");
|
||||
const blasint notransA = LAPACK(lsame)(tranA, "N");
|
||||
const blasint transA = LAPACK(lsame)(tranA, "T");
|
||||
const blasint ctransA = LAPACK(lsame)(tranA, "C");
|
||||
const blasint notransB = LAPACK(lsame)(tranB, "N");
|
||||
const blasint transB = LAPACK(lsame)(tranB, "T");
|
||||
const blasint ctransB = LAPACK(lsame)(tranB, "C");
|
||||
*info = 0;
|
||||
if (!transA && !ctransA && !notransA)
|
||||
*info = -1;
|
||||
|
|
@ -44,8 +44,8 @@ void RELAPACK_dtrsyl(
|
|||
else if (*ldC < MAX(1, *m))
|
||||
*info = -11;
|
||||
if (*info) {
|
||||
const int minfo = -*info;
|
||||
LAPACK(xerbla)("DTRSYL", &minfo);
|
||||
const blasint minfo = -*info;
|
||||
LAPACK(xerbla)("DTRSYL", &minfo, strlen("DTRSYL"));
|
||||
return;
|
||||
}
|
||||
|
||||
|
|
@ -60,11 +60,11 @@ void RELAPACK_dtrsyl(
|
|||
|
||||
/** dtrsyl's recursive compute kernel */
|
||||
static void RELAPACK_dtrsyl_rec(
|
||||
const char *tranA, const char *tranB, const int *isgn,
|
||||
const int *m, const int *n,
|
||||
const double *A, const int *ldA, const double *B, const int *ldB,
|
||||
double *C, const int *ldC, double *scale,
|
||||
int *info
|
||||
const char *tranA, const char *tranB, const blasint *isgn,
|
||||
const blasint *m, const blasint *n,
|
||||
const double *A, const blasint *ldA, const double *B, const blasint *ldB,
|
||||
double *C, const blasint *ldC, double *scale,
|
||||
blasint *info
|
||||
) {
|
||||
|
||||
if (*m <= MAX(CROSSOVER_DTRSYL, 1) && *n <= MAX(CROSSOVER_DTRSYL, 1)) {
|
||||
|
|
@ -77,20 +77,20 @@ static void RELAPACK_dtrsyl_rec(
|
|||
const double ONE[] = { 1. };
|
||||
const double MONE[] = { -1. };
|
||||
const double MSGN[] = { -*isgn };
|
||||
const int iONE[] = { 1 };
|
||||
const blasint iONE[] = { 1 };
|
||||
|
||||
// Outputs
|
||||
double scale1[] = { 1. };
|
||||
double scale2[] = { 1. };
|
||||
int info1[] = { 0 };
|
||||
int info2[] = { 0 };
|
||||
blasint info1[] = { 0 };
|
||||
blasint info2[] = { 0 };
|
||||
|
||||
if (*m > *n) {
|
||||
// Splitting
|
||||
int m1 = DREC_SPLIT(*m);
|
||||
blasint m1 = DREC_SPLIT(*m);
|
||||
if (A[m1 + *ldA * (m1 - 1)])
|
||||
m1++;
|
||||
const int m2 = *m - m1;
|
||||
const blasint m2 = *m - m1;
|
||||
|
||||
// A_TL A_TR
|
||||
// 0 A_BR
|
||||
|
|
@ -126,10 +126,10 @@ static void RELAPACK_dtrsyl_rec(
|
|||
}
|
||||
} else {
|
||||
// Splitting
|
||||
int n1 = DREC_SPLIT(*n);
|
||||
blasint n1 = DREC_SPLIT(*n);
|
||||
if (B[n1 + *ldB * (n1 - 1)])
|
||||
n1++;
|
||||
const int n2 = *n - n1;
|
||||
const blasint n2 = *n - n1;
|
||||
|
||||
// B_TL B_TR
|
||||
// 0 B_BR
|
||||
|
|
|
|||
|
|
@ -14,52 +14,52 @@
|
|||
|
||||
/* Table of constant values */
|
||||
|
||||
static int c__1 = 1;
|
||||
static int c_false = FALSE_;
|
||||
static int c__2 = 2;
|
||||
static blasint c__1 = 1;
|
||||
static blasint c_false = FALSE_;
|
||||
static blasint c__2 = 2;
|
||||
static double c_b26 = 1.;
|
||||
static double c_b30 = 0.;
|
||||
static int c_true = TRUE_;
|
||||
static blasint c_true = TRUE_;
|
||||
|
||||
int RELAPACK_dtrsyl_rec2(char *trana, char *tranb, int *isgn, int
|
||||
*m, int *n, double *a, int *lda, double *b, int *
|
||||
ldb, double *c__, int *ldc, double *scale, int *info,
|
||||
int RELAPACK_dtrsyl_rec2(char *trana, char *tranb, blasint *isgn, int
|
||||
*m, blasint *n, double *a, blasint *lda, double *b, blasint *
|
||||
ldb, double *c__, blasint *ldc, double *scale, blasint *info,
|
||||
ftnlen trana_len, ftnlen tranb_len)
|
||||
{
|
||||
/* System generated locals */
|
||||
int a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2,
|
||||
blasint a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2,
|
||||
i__3, i__4;
|
||||
double d__1, d__2;
|
||||
|
||||
/* Local variables */
|
||||
static int j, k, l;
|
||||
static blasint j, k, l;
|
||||
static double x[4] /* was [2][2] */;
|
||||
static int k1, k2, l1, l2;
|
||||
static blasint k1, k2, l1, l2;
|
||||
static double a11, db, da11, vec[4] /* was [2][2] */, dum[1], eps,
|
||||
sgn;
|
||||
extern double ddot_(int *, double *, int *, double *,
|
||||
int *);
|
||||
static int ierr;
|
||||
extern double ddot_(int *, double *, blasint *, double *,
|
||||
blasint *);
|
||||
static blasint ierr;
|
||||
static double smin, suml, sumr;
|
||||
extern /* Subroutine */ int dscal_(int *, double *, double *,
|
||||
int *);
|
||||
extern int lsame_(char *, char *, ftnlen, ftnlen);
|
||||
static int knext, lnext;
|
||||
extern /* Subroutine */ blasint dscal_(int *, double *, double *,
|
||||
blasint *);
|
||||
extern blasint lsame_(char *, char *, ftnlen, ftnlen);
|
||||
static blasint knext, lnext;
|
||||
static double xnorm;
|
||||
extern /* Subroutine */ int dlaln2_(int *, int *, int *,
|
||||
double *, double *, double *, int *, double *,
|
||||
double *, double *, int *, double *, double *
|
||||
, double *, int *, double *, double *, int *),
|
||||
dlasy2_(int *, int *, int *, int *, int *,
|
||||
double *, int *, double *, int *, double *,
|
||||
int *, double *, double *, int *, double *,
|
||||
int *), dlabad_(double *, double *);
|
||||
extern double dlamch_(char *, ftnlen), dlange_(char *, int *,
|
||||
int *, double *, int *, double *, ftnlen);
|
||||
extern /* Subroutine */ blasint dlaln2_(int *, blasint *, blasint *,
|
||||
double *, double *, double *, blasint *, double *,
|
||||
double *, double *, blasint *, double *, double *
|
||||
, double *, blasint *, double *, double *, blasint *),
|
||||
dlasy2_(int *, blasint *, blasint *, blasint *, blasint *,
|
||||
double *, blasint *, double *, blasint *, double *,
|
||||
blasint *, double *, double *, blasint *, double *,
|
||||
blasint *), dlabad_(double *, double *);
|
||||
extern double dlamch_(char *, ftnlen), dlange_(char *, blasint *,
|
||||
blasint *, double *, blasint *, double *, ftnlen);
|
||||
static double scaloc;
|
||||
extern /* Subroutine */ int xerbla_(char *, int *, ftnlen);
|
||||
extern /* Subroutine */ blasint xerbla_(char *, blasint *, ftnlen);
|
||||
static double bignum;
|
||||
static int notrna, notrnb;
|
||||
static blasint notrna, notrnb;
|
||||
static double smlnum;
|
||||
|
||||
/* Parameter adjustments */
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
#include "relapack.h"
|
||||
|
||||
static void RELAPACK_dtrtri_rec(const char *, const char *, const int *,
|
||||
double *, const int *, int *);
|
||||
static void RELAPACK_dtrtri_rec(const char *, const char *, const blasint *,
|
||||
double *, const blasint *, blasint *);
|
||||
|
||||
|
||||
/** DTRTRI computes the inverse of a real upper or lower triangular matrix A.
|
||||
|
|
@ -11,16 +11,16 @@ static void RELAPACK_dtrtri_rec(const char *, const char *, const int *,
|
|||
* http://www.netlib.org/lapack/explore-html/d5/dba/dtrtri_8f.html
|
||||
* */
|
||||
void RELAPACK_dtrtri(
|
||||
const char *uplo, const char *diag, const int *n,
|
||||
double *A, const int *ldA,
|
||||
int *info
|
||||
const char *uplo, const char *diag, const blasint *n,
|
||||
double *A, const blasint *ldA,
|
||||
blasint *info
|
||||
) {
|
||||
|
||||
// Check arguments
|
||||
const int lower = LAPACK(lsame)(uplo, "L");
|
||||
const int upper = LAPACK(lsame)(uplo, "U");
|
||||
const int nounit = LAPACK(lsame)(diag, "N");
|
||||
const int unit = LAPACK(lsame)(diag, "U");
|
||||
const blasint lower = LAPACK(lsame)(uplo, "L");
|
||||
const blasint upper = LAPACK(lsame)(uplo, "U");
|
||||
const blasint nounit = LAPACK(lsame)(diag, "N");
|
||||
const blasint unit = LAPACK(lsame)(diag, "U");
|
||||
*info = 0;
|
||||
if (!lower && !upper)
|
||||
*info = -1;
|
||||
|
|
@ -31,8 +31,8 @@ void RELAPACK_dtrtri(
|
|||
else if (*ldA < MAX(1, *n))
|
||||
*info = -5;
|
||||
if (*info) {
|
||||
const int minfo = -*info;
|
||||
LAPACK(xerbla)("DTRTRI", &minfo);
|
||||
const blasint minfo = -*info;
|
||||
LAPACK(xerbla)("DTRTRI", &minfo, strlen("DTRTRI"));
|
||||
return;
|
||||
}
|
||||
|
||||
|
|
@ -42,7 +42,7 @@ void RELAPACK_dtrtri(
|
|||
|
||||
// check for singularity
|
||||
if (nounit) {
|
||||
int i;
|
||||
blasint i;
|
||||
for (i = 0; i < *n; i++)
|
||||
if (A[i + *ldA * i] == 0) {
|
||||
*info = i;
|
||||
|
|
@ -57,9 +57,9 @@ void RELAPACK_dtrtri(
|
|||
|
||||
/** dtrtri's recursive compute kernel */
|
||||
static void RELAPACK_dtrtri_rec(
|
||||
const char *uplo, const char *diag, const int *n,
|
||||
double *A, const int *ldA,
|
||||
int *info
|
||||
const char *uplo, const char *diag, const blasint *n,
|
||||
double *A, const blasint *ldA,
|
||||
blasint *info
|
||||
){
|
||||
|
||||
if (*n <= MAX(CROSSOVER_DTRTRI, 1)) {
|
||||
|
|
@ -73,8 +73,8 @@ static void RELAPACK_dtrtri_rec(
|
|||
const double MONE[] = { -1. };
|
||||
|
||||
// Splitting
|
||||
const int n1 = DREC_SPLIT(*n);
|
||||
const int n2 = *n - n1;
|
||||
const blasint n1 = DREC_SPLIT(*n);
|
||||
const blasint n2 = *n - n1;
|
||||
|
||||
// A_TL A_TR
|
||||
// A_BL A_BR
|
||||
|
|
|
|||
|
|
@ -9,7 +9,7 @@
|
|||
#endif
|
||||
#endif
|
||||
|
||||
void sig_die(const char *s, int kill) {
|
||||
void sig_die(const char *s, blasint kill) {
|
||||
/* print error message, then clear buffers */
|
||||
fprintf(stderr, "%s\n", s);
|
||||
|
||||
|
|
|
|||
|
|
@ -7,6 +7,19 @@
|
|||
#ifndef F2C_INCLUDE
|
||||
#define F2C_INCLUDE
|
||||
|
||||
#ifdef USE64BITINT
|
||||
typedef BLASLONG blasint;
|
||||
#if defined(OS_WINDOWS) && defined(__64BIT__)
|
||||
#define blasabs(x) llabs(x)
|
||||
#else
|
||||
#define blasabs(x) labs(x)
|
||||
#endif
|
||||
#else
|
||||
typedef int blasint;
|
||||
#define blasabs(x) abs(x)
|
||||
#endif
|
||||
|
||||
|
||||
typedef long int integer;
|
||||
typedef unsigned long int uinteger;
|
||||
typedef char *address;
|
||||
|
|
|
|||
|
|
@ -1,80 +1,80 @@
|
|||
#ifndef LAPACK_H
|
||||
#define LAPACK_H
|
||||
|
||||
extern int LAPACK(lsame)(const char *, const char *);
|
||||
extern int LAPACK(xerbla)(const char *, const int *);
|
||||
extern blasint LAPACK(lsame)(const char *, const char *);
|
||||
extern blasint LAPACK(xerbla)(const char *, const blasint *, int);
|
||||
|
||||
extern void LAPACK(slaswp)(const int *, float *, const int *, const int *, const int *, const int *, const int *);
|
||||
extern void LAPACK(dlaswp)(const int *, double *, const int *, const int *, const int *, const int *, const int *);
|
||||
extern void LAPACK(claswp)(const int *, float *, const int *, const int *, const int *, const int *, const int *);
|
||||
extern void LAPACK(zlaswp)(const int *, double *, const int *, const int *, const int *, const int *, const int *);
|
||||
extern void LAPACK(slaswp)(const blasint *, float *, const blasint *, const blasint *, const blasint *, const blasint *, const blasint *);
|
||||
extern void LAPACK(dlaswp)(const blasint *, double *, const blasint *, const blasint *, const blasint *, const blasint *, const blasint *);
|
||||
extern void LAPACK(claswp)(const blasint *, float *, const blasint *, const blasint *, const blasint *, const blasint *, const blasint *);
|
||||
extern void LAPACK(zlaswp)(const blasint *, double *, const blasint *, const blasint *, const blasint *, const blasint *, const blasint *);
|
||||
|
||||
extern void LAPACK(slaset)(const char *, const int *, const int *, const float *, const float *, float *, const int *);
|
||||
extern void LAPACK(dlaset)(const char *, const int *, const int *, const double *, const double *, double *, const int *);
|
||||
extern void LAPACK(claset)(const char *, const int *, const int *, const float *, const float *, float *, const int *);
|
||||
extern void LAPACK(zlaset)(const char *, const int *, const int *, const double *, const double *, double *, const int *);
|
||||
extern void LAPACK(slaset)(const char *, const blasint *, const blasint *, const float *, const float *, float *, const blasint *);
|
||||
extern void LAPACK(dlaset)(const char *, const blasint *, const blasint *, const double *, const double *, double *, const blasint *);
|
||||
extern void LAPACK(claset)(const char *, const blasint *, const blasint *, const float *, const float *, float *, const blasint *);
|
||||
extern void LAPACK(zlaset)(const char *, const blasint *, const blasint *, const double *, const double *, double *, const blasint *);
|
||||
|
||||
extern void LAPACK(slacpy)(const char *, const int *, const int *, const float *, const int *, float *, const int *);
|
||||
extern void LAPACK(dlacpy)(const char *, const int *, const int *, const double *, const int *, double *, const int *);
|
||||
extern void LAPACK(clacpy)(const char *, const int *, const int *, const float *, const int *, float *, const int *);
|
||||
extern void LAPACK(zlacpy)(const char *, const int *, const int *, const double *, const int *, double *, const int *);
|
||||
extern void LAPACK(slacpy)(const char *, const blasint *, const blasint *, const float *, const blasint *, float *, const blasint *);
|
||||
extern void LAPACK(dlacpy)(const char *, const blasint *, const blasint *, const double *, const blasint *, double *, const blasint *);
|
||||
extern void LAPACK(clacpy)(const char *, const blasint *, const blasint *, const float *, const blasint *, float *, const blasint *);
|
||||
extern void LAPACK(zlacpy)(const char *, const blasint *, const blasint *, const double *, const blasint *, double *, const blasint *);
|
||||
|
||||
extern void LAPACK(slascl)(const char *, const int *, const int *, const float *, const float *, const int *, const int *, float *, const int *, int *);
|
||||
extern void LAPACK(dlascl)(const char *, const int *, const int *, const double *, const double *, const int *, const int *, double *, const int *, int *);
|
||||
extern void LAPACK(clascl)(const char *, const int *, const int *, const float *, const float *, const int *, const int *, float *, const int *, int *);
|
||||
extern void LAPACK(zlascl)(const char *, const int *, const int *, const double *, const double *, const int *, const int *, double *, const int *, int *);
|
||||
extern void LAPACK(slascl)(const char *, const blasint *, const blasint *, const float *, const float *, const blasint *, const blasint *, float *, const blasint *, blasint *);
|
||||
extern void LAPACK(dlascl)(const char *, const blasint *, const blasint *, const double *, const double *, const blasint *, const blasint *, double *, const blasint *, blasint *);
|
||||
extern void LAPACK(clascl)(const char *, const blasint *, const blasint *, const float *, const float *, const blasint *, const blasint *, float *, const blasint *, blasint *);
|
||||
extern void LAPACK(zlascl)(const char *, const blasint *, const blasint *, const double *, const double *, const blasint *, const blasint *, double *, const blasint *, blasint *);
|
||||
|
||||
extern void LAPACK(slauu2)(const char *, const int *, float *, const int *, int *);
|
||||
extern void LAPACK(dlauu2)(const char *, const int *, double *, const int *, int *);
|
||||
extern void LAPACK(clauu2)(const char *, const int *, float *, const int *, int *);
|
||||
extern void LAPACK(zlauu2)(const char *, const int *, double *, const int *, int *);
|
||||
extern void LAPACK(slauu2)(const char *, const blasint *, float *, const blasint *, blasint *);
|
||||
extern void LAPACK(dlauu2)(const char *, const blasint *, double *, const blasint *, blasint *);
|
||||
extern void LAPACK(clauu2)(const char *, const blasint *, float *, const blasint *, blasint *);
|
||||
extern void LAPACK(zlauu2)(const char *, const blasint *, double *, const blasint *, blasint *);
|
||||
|
||||
extern void LAPACK(ssygs2)(const int *, const char *, const int *, float *, const int *, const float *, const int *, int *);
|
||||
extern void LAPACK(dsygs2)(const int *, const char *, const int *, double *, const int *, const double *, const int *, int *);
|
||||
extern void LAPACK(chegs2)(const int *, const char *, const int *, float *, const int *, const float *, const int *, int *);
|
||||
extern void LAPACK(zhegs2)(const int *, const char *, const int *, double *, const int *, const double *, const int *, int *);
|
||||
extern void LAPACK(ssygs2)(const blasint *, const char *, const blasint *, float *, const blasint *, const float *, const blasint *, blasint *);
|
||||
extern void LAPACK(dsygs2)(const blasint *, const char *, const blasint *, double *, const blasint *, const double *, const blasint *, blasint *);
|
||||
extern void LAPACK(chegs2)(const blasint *, const char *, const blasint *, float *, const blasint *, const float *, const blasint *, blasint *);
|
||||
extern void LAPACK(zhegs2)(const blasint *, const char *, const blasint *, double *, const blasint *, const double *, const blasint *, blasint *);
|
||||
|
||||
extern void LAPACK(strti2)(const char *, const char *, const int *, float *, const int *, int *);
|
||||
extern void LAPACK(dtrti2)(const char *, const char *, const int *, double *, const int *, int *);
|
||||
extern void LAPACK(ctrti2)(const char *, const char *, const int *, float *, const int *, int *);
|
||||
extern void LAPACK(ztrti2)(const char *, const char *, const int *, double *, const int *, int *);
|
||||
extern void LAPACK(strti2)(const char *, const char *, const blasint *, float *, const blasint *, blasint *);
|
||||
extern void LAPACK(dtrti2)(const char *, const char *, const blasint *, double *, const blasint *, blasint *);
|
||||
extern void LAPACK(ctrti2)(const char *, const char *, const blasint *, float *, const blasint *, blasint *);
|
||||
extern void LAPACK(ztrti2)(const char *, const char *, const blasint *, double *, const blasint *, blasint *);
|
||||
|
||||
extern void LAPACK(spotf2)(const char *, const int *, float *, const int *, int *);
|
||||
extern void LAPACK(dpotf2)(const char *, const int *, double *, const int *, int *);
|
||||
extern void LAPACK(cpotf2)(const char *, const int *, float *, const int *, int *);
|
||||
extern void LAPACK(zpotf2)(const char *, const int *, double *, const int *, int *);
|
||||
extern void LAPACK(spotf2)(const char *, const blasint *, float *, const blasint *, blasint *);
|
||||
extern void LAPACK(dpotf2)(const char *, const blasint *, double *, const blasint *, blasint *);
|
||||
extern void LAPACK(cpotf2)(const char *, const blasint *, float *, const blasint *, blasint *);
|
||||
extern void LAPACK(zpotf2)(const char *, const blasint *, double *, const blasint *, blasint *);
|
||||
|
||||
extern void LAPACK(spbtf2)(const char *, const int *, const int *, float *, const int *, int *);
|
||||
extern void LAPACK(dpbtf2)(const char *, const int *, const int *, double *, const int *, int *);
|
||||
extern void LAPACK(cpbtf2)(const char *, const int *, const int *, float *, const int *, int *);
|
||||
extern void LAPACK(zpbtf2)(const char *, const int *, const int *, double *, const int *, int *);
|
||||
extern void LAPACK(spbtf2)(const char *, const blasint *, const blasint *, float *, const blasint *, blasint *);
|
||||
extern void LAPACK(dpbtf2)(const char *, const blasint *, const blasint *, double *, const blasint *, blasint *);
|
||||
extern void LAPACK(cpbtf2)(const char *, const blasint *, const blasint *, float *, const blasint *, blasint *);
|
||||
extern void LAPACK(zpbtf2)(const char *, const blasint *, const blasint *, double *, const blasint *, blasint *);
|
||||
|
||||
extern void LAPACK(ssytf2)(const char *, const int *, float *, const int *, int *, int *);
|
||||
extern void LAPACK(dsytf2)(const char *, const int *, double *, const int *, int *, int *);
|
||||
extern void LAPACK(csytf2)(const char *, const int *, float *, const int *, int *, int *);
|
||||
extern void LAPACK(chetf2)(const char *, const int *, float *, const int *, int *, int *);
|
||||
extern void LAPACK(zsytf2)(const char *, const int *, double *, const int *, int *, int *);
|
||||
extern void LAPACK(zhetf2)(const char *, const int *, double *, const int *, int *, int *);
|
||||
extern void LAPACK(ssytf2_rook)(const char *, const int *, float *, const int *, int *, int *);
|
||||
extern void LAPACK(dsytf2_rook)(const char *, const int *, double *, const int *, int *, int *);
|
||||
extern void LAPACK(csytf2_rook)(const char *, const int *, float *, const int *, int *, int *);
|
||||
extern void LAPACK(chetf2_rook)(const char *, const int *, float *, const int *, int *, int *);
|
||||
extern void LAPACK(zsytf2_rook)(const char *, const int *, double *, const int *, int *, int *);
|
||||
extern void LAPACK(zhetf2_rook)(const char *, const int *, double *, const int *, int *, int *);
|
||||
extern void LAPACK(ssytf2)(const char *, const blasint *, float *, const blasint *, blasint *, blasint *);
|
||||
extern void LAPACK(dsytf2)(const char *, const blasint *, double *, const blasint *, blasint *, blasint *);
|
||||
extern void LAPACK(csytf2)(const char *, const blasint *, float *, const blasint *, blasint *, blasint *);
|
||||
extern void LAPACK(chetf2)(const char *, const blasint *, float *, const blasint *, blasint *, blasint *);
|
||||
extern void LAPACK(zsytf2)(const char *, const blasint *, double *, const blasint *, blasint *, blasint *);
|
||||
extern void LAPACK(zhetf2)(const char *, const blasint *, double *, const blasint *, blasint *, blasint *);
|
||||
extern void LAPACK(ssytf2_rook)(const char *, const blasint *, float *, const blasint *, blasint *, blasint *);
|
||||
extern void LAPACK(dsytf2_rook)(const char *, const blasint *, double *, const blasint *, blasint *, blasint *);
|
||||
extern void LAPACK(csytf2_rook)(const char *, const blasint *, float *, const blasint *, blasint *, blasint *);
|
||||
extern void LAPACK(chetf2_rook)(const char *, const blasint *, float *, const blasint *, blasint *, blasint *);
|
||||
extern void LAPACK(zsytf2_rook)(const char *, const blasint *, double *, const blasint *, blasint *, blasint *);
|
||||
extern void LAPACK(zhetf2_rook)(const char *, const blasint *, double *, const blasint *, blasint *, blasint *);
|
||||
|
||||
extern void LAPACK(sgetf2)(const int *, const int *, float *, const int *, int *, int *);
|
||||
extern void LAPACK(dgetf2)(const int *, const int *, double *, const int *, int *, int *);
|
||||
extern void LAPACK(cgetf2)(const int *, const int *, float *, const int *, int *, int *);
|
||||
extern void LAPACK(zgetf2)(const int *, const int *, double *, const int *, int *, int *);
|
||||
extern void LAPACK(sgetf2)(const blasint *, const blasint *, float *, const blasint *, blasint *, blasint *);
|
||||
extern void LAPACK(dgetf2)(const blasint *, const blasint *, double *, const blasint *, blasint *, blasint *);
|
||||
extern void LAPACK(cgetf2)(const blasint *, const blasint *, float *, const blasint *, blasint *, blasint *);
|
||||
extern void LAPACK(zgetf2)(const blasint *, const blasint *, double *, const blasint *, blasint *, blasint *);
|
||||
|
||||
extern void LAPACK(sgbtf2)(const int *, const int *, const int *, const int *, float *, const int *, int *, int *);
|
||||
extern void LAPACK(dgbtf2)(const int *, const int *, const int *, const int *, double *, const int *, int *, int *);
|
||||
extern void LAPACK(cgbtf2)(const int *, const int *, const int *, const int *, float *, const int *, int *, int *);
|
||||
extern void LAPACK(zgbtf2)(const int *, const int *, const int *, const int *, double *, const int *, int *, int *);
|
||||
extern void LAPACK(sgbtf2)(const blasint *, const blasint *, const blasint *, const blasint *, float *, const blasint *, blasint *, blasint *);
|
||||
extern void LAPACK(dgbtf2)(const blasint *, const blasint *, const blasint *, const blasint *, double *, const blasint *, blasint *, blasint *);
|
||||
extern void LAPACK(cgbtf2)(const blasint *, const blasint *, const blasint *, const blasint *, float *, const blasint *, blasint *, blasint *);
|
||||
extern void LAPACK(zgbtf2)(const blasint *, const blasint *, const blasint *, const blasint *, double *, const blasint *, blasint *, blasint *);
|
||||
|
||||
extern void LAPACK(stgsy2)(const char *, const int *, const int *, const int *, const float *, const int *, const float *, const int *, float *, const int *, const float *, const int *, const float *, const int *, float *, const int *, float *, float *, float *, int *, int *, int *);
|
||||
extern void LAPACK(dtgsy2)(const char *, const int *, const int *, const int *, const double *, const int *, const double *, const int *, double *, const int *, const double *, const int *, const double *, const int *, double *, const int *, double *, double *, double *, int *, int *, int *);
|
||||
extern void LAPACK(ctgsy2)(const char *, const int *, const int *, const int *, const float *, const int *, const float *, const int *, float *, const int *, const float *, const int *, const float *, const int *, float *, const int *, float *, float *, float *, int *);
|
||||
extern void LAPACK(ztgsy2)(const char *, const int *, const int *, const int *, const double *, const int *, const double *, const int *, double *, const int *, const double *, const int *, const double *, const int *, double *, const int *, double *, double *, double *, int *);
|
||||
extern void LAPACK(stgsy2)(const char *, const blasint *, const blasint *, const blasint *, const float *, const blasint *, const float *, const blasint *, float *, const blasint *, const float *, const blasint *, const float *, const blasint *, float *, const blasint *, float *, float *, float *, blasint *, blasint *, blasint *);
|
||||
extern void LAPACK(dtgsy2)(const char *, const blasint *, const blasint *, const blasint *, const double *, const blasint *, const double *, const blasint *, double *, const blasint *, const double *, const blasint *, const double *, const blasint *, double *, const blasint *, double *, double *, double *, blasint *, blasint *, blasint *);
|
||||
extern void LAPACK(ctgsy2)(const char *, const blasint *, const blasint *, const blasint *, const float *, const blasint *, const float *, const blasint *, float *, const blasint *, const float *, const blasint *, const float *, const blasint *, float *, const blasint *, float *, float *, float *, blasint *);
|
||||
extern void LAPACK(ztgsy2)(const char *, const blasint *, const blasint *, const blasint *, const double *, const blasint *, const double *, const blasint *, double *, const blasint *, const double *, const blasint *, const double *, const blasint *, double *, const blasint *, double *, double *, double *, blasint *);
|
||||
|
||||
#endif /* LAPACK_H */
|
||||
|
|
|
|||
|
|
@ -6,9 +6,9 @@
|
|||
|
||||
#if INCLUDE_SLAUUM
|
||||
void LAPACK(slauum)(
|
||||
const char *uplo, const int *n,
|
||||
float *A, const int *ldA,
|
||||
int *info
|
||||
const char *uplo, const blasint *n,
|
||||
float *A, const blasint *ldA,
|
||||
blasint *info
|
||||
) {
|
||||
RELAPACK_slauum(uplo, n, A, ldA, info);
|
||||
}
|
||||
|
|
@ -16,9 +16,9 @@ void LAPACK(slauum)(
|
|||
|
||||
#if INCLUDE_DLAUUM
|
||||
void LAPACK(dlauum)(
|
||||
const char *uplo, const int *n,
|
||||
double *A, const int *ldA,
|
||||
int *info
|
||||
const char *uplo, const blasint *n,
|
||||
double *A, const blasint *ldA,
|
||||
blasint *info
|
||||
) {
|
||||
RELAPACK_dlauum(uplo, n, A, ldA, info);
|
||||
}
|
||||
|
|
@ -26,9 +26,9 @@ void LAPACK(dlauum)(
|
|||
|
||||
#if INCLUDE_CLAUUM
|
||||
void LAPACK(clauum)(
|
||||
const char *uplo, const int *n,
|
||||
float *A, const int *ldA,
|
||||
int *info
|
||||
const char *uplo, const blasint *n,
|
||||
float *A, const blasint *ldA,
|
||||
blasint *info
|
||||
) {
|
||||
RELAPACK_clauum(uplo, n, A, ldA, info);
|
||||
}
|
||||
|
|
@ -36,9 +36,9 @@ void LAPACK(clauum)(
|
|||
|
||||
#if INCLUDE_ZLAUUM
|
||||
void LAPACK(zlauum)(
|
||||
const char *uplo, const int *n,
|
||||
double *A, const int *ldA,
|
||||
int *info
|
||||
const char *uplo, const blasint *n,
|
||||
double *A, const blasint *ldA,
|
||||
blasint *info
|
||||
) {
|
||||
RELAPACK_zlauum(uplo, n, A, ldA, info);
|
||||
}
|
||||
|
|
@ -51,9 +51,9 @@ void LAPACK(zlauum)(
|
|||
|
||||
#if INCLUDE_SSYGST
|
||||
void LAPACK(ssygst)(
|
||||
const int *itype, const char *uplo, const int *n,
|
||||
float *A, const int *ldA, const float *B, const int *ldB,
|
||||
int *info
|
||||
const blasint *itype, const char *uplo, const blasint *n,
|
||||
float *A, const blasint *ldA, const float *B, const blasint *ldB,
|
||||
blasint *info
|
||||
) {
|
||||
RELAPACK_ssygst(itype, uplo, n, A, ldA, B, ldB, info);
|
||||
}
|
||||
|
|
@ -61,9 +61,9 @@ void LAPACK(ssygst)(
|
|||
|
||||
#if INCLUDE_DSYGST
|
||||
void LAPACK(dsygst)(
|
||||
const int *itype, const char *uplo, const int *n,
|
||||
double *A, const int *ldA, const double *B, const int *ldB,
|
||||
int *info
|
||||
const blasint *itype, const char *uplo, const blasint *n,
|
||||
double *A, const blasint *ldA, const double *B, const blasint *ldB,
|
||||
blasint *info
|
||||
) {
|
||||
RELAPACK_dsygst(itype, uplo, n, A, ldA, B, ldB, info);
|
||||
}
|
||||
|
|
@ -71,9 +71,9 @@ void LAPACK(dsygst)(
|
|||
|
||||
#if INCLUDE_CHEGST
|
||||
void LAPACK(chegst)(
|
||||
const int *itype, const char *uplo, const int *n,
|
||||
float *A, const int *ldA, const float *B, const int *ldB,
|
||||
int *info
|
||||
const blasint *itype, const char *uplo, const blasint *n,
|
||||
float *A, const blasint *ldA, const float *B, const blasint *ldB,
|
||||
blasint *info
|
||||
) {
|
||||
RELAPACK_chegst(itype, uplo, n, A, ldA, B, ldB, info);
|
||||
}
|
||||
|
|
@ -81,9 +81,9 @@ void LAPACK(chegst)(
|
|||
|
||||
#if INCLUDE_ZHEGST
|
||||
void LAPACK(zhegst)(
|
||||
const int *itype, const char *uplo, const int *n,
|
||||
double *A, const int *ldA, const double *B, const int *ldB,
|
||||
int *info
|
||||
const blasint *itype, const char *uplo, const blasint *n,
|
||||
double *A, const blasint *ldA, const double *B, const blasint *ldB,
|
||||
blasint *info
|
||||
) {
|
||||
RELAPACK_zhegst(itype, uplo, n, A, ldA, B, ldB, info);
|
||||
}
|
||||
|
|
@ -96,9 +96,9 @@ void LAPACK(zhegst)(
|
|||
|
||||
#if INCLUDE_STRTRI
|
||||
void LAPACK(strtri)(
|
||||
const char *uplo, const char *diag, const int *n,
|
||||
float *A, const int *ldA,
|
||||
int *info
|
||||
const char *uplo, const char *diag, const blasint *n,
|
||||
float *A, const blasint *ldA,
|
||||
blasint *info
|
||||
) {
|
||||
RELAPACK_strtri(uplo, diag, n, A, ldA, info);
|
||||
}
|
||||
|
|
@ -106,9 +106,9 @@ void LAPACK(strtri)(
|
|||
|
||||
#if INCLUDE_DTRTRI
|
||||
void LAPACK(dtrtri)(
|
||||
const char *uplo, const char *diag, const int *n,
|
||||
double *A, const int *ldA,
|
||||
int *info
|
||||
const char *uplo, const char *diag, const blasint *n,
|
||||
double *A, const blasint *ldA,
|
||||
blasint *info
|
||||
) {
|
||||
RELAPACK_dtrtri(uplo, diag, n, A, ldA, info);
|
||||
}
|
||||
|
|
@ -116,9 +116,9 @@ void LAPACK(dtrtri)(
|
|||
|
||||
#if INCLUDE_CTRTRI
|
||||
void LAPACK(ctrtri)(
|
||||
const char *uplo, const char *diag, const int *n,
|
||||
float *A, const int *ldA,
|
||||
int *info
|
||||
const char *uplo, const char *diag, const blasint *n,
|
||||
float *A, const blasint *ldA,
|
||||
blasint *info
|
||||
) {
|
||||
RELAPACK_ctrtri(uplo, diag, n, A, ldA, info);
|
||||
}
|
||||
|
|
@ -126,9 +126,9 @@ void LAPACK(ctrtri)(
|
|||
|
||||
#if INCLUDE_ZTRTRI
|
||||
void LAPACK(ztrtri)(
|
||||
const char *uplo, const char *diag, const int *n,
|
||||
double *A, const int *ldA,
|
||||
int *info
|
||||
const char *uplo, const char *diag, const blasint *n,
|
||||
double *A, const blasint *ldA,
|
||||
blasint *info
|
||||
) {
|
||||
RELAPACK_ztrtri(uplo, diag, n, A, ldA, info);
|
||||
}
|
||||
|
|
@ -141,9 +141,9 @@ void LAPACK(ztrtri)(
|
|||
|
||||
#if INCLUDE_SPOTRF
|
||||
void LAPACK(spotrf)(
|
||||
const char *uplo, const int *n,
|
||||
float *A, const int *ldA,
|
||||
int *info
|
||||
const char *uplo, const blasint *n,
|
||||
float *A, const blasint *ldA,
|
||||
blasint *info
|
||||
) {
|
||||
RELAPACK_spotrf(uplo, n, A, ldA, info);
|
||||
}
|
||||
|
|
@ -151,9 +151,9 @@ void LAPACK(spotrf)(
|
|||
|
||||
#if INCLUDE_DPOTRF
|
||||
void LAPACK(dpotrf)(
|
||||
const char *uplo, const int *n,
|
||||
double *A, const int *ldA,
|
||||
int *info
|
||||
const char *uplo, const blasint *n,
|
||||
double *A, const blasint *ldA,
|
||||
blasint *info
|
||||
) {
|
||||
RELAPACK_dpotrf(uplo, n, A, ldA, info);
|
||||
}
|
||||
|
|
@ -161,9 +161,9 @@ void LAPACK(dpotrf)(
|
|||
|
||||
#if INCLUDE_CPOTRF
|
||||
void LAPACK(cpotrf)(
|
||||
const char *uplo, const int *n,
|
||||
float *A, const int *ldA,
|
||||
int *info
|
||||
const char *uplo, const blasint *n,
|
||||
float *A, const blasint *ldA,
|
||||
blasint *info
|
||||
) {
|
||||
RELAPACK_cpotrf(uplo, n, A, ldA, info);
|
||||
}
|
||||
|
|
@ -171,9 +171,9 @@ void LAPACK(cpotrf)(
|
|||
|
||||
#if INCLUDE_ZPOTRF
|
||||
void LAPACK(zpotrf)(
|
||||
const char *uplo, const int *n,
|
||||
double *A, const int *ldA,
|
||||
int *info
|
||||
const char *uplo, const blasint *n,
|
||||
double *A, const blasint *ldA,
|
||||
blasint *info
|
||||
) {
|
||||
RELAPACK_zpotrf(uplo, n, A, ldA, info);
|
||||
}
|
||||
|
|
@ -186,9 +186,9 @@ void LAPACK(zpotrf)(
|
|||
|
||||
#if INCLUDE_SPBTRF
|
||||
void LAPACK(spbtrf)(
|
||||
const char *uplo, const int *n, const int *kd,
|
||||
float *Ab, const int *ldAb,
|
||||
int *info
|
||||
const char *uplo, const blasint *n, const blasint *kd,
|
||||
float *Ab, const blasint *ldAb,
|
||||
blasint *info
|
||||
) {
|
||||
RELAPACK_spbtrf(uplo, n, kd, Ab, ldAb, info);
|
||||
}
|
||||
|
|
@ -196,9 +196,9 @@ void LAPACK(spbtrf)(
|
|||
|
||||
#if INCLUDE_DPBTRF
|
||||
void LAPACK(dpbtrf)(
|
||||
const char *uplo, const int *n, const int *kd,
|
||||
double *Ab, const int *ldAb,
|
||||
int *info
|
||||
const char *uplo, const blasint *n, const blasint *kd,
|
||||
double *Ab, const blasint *ldAb,
|
||||
blasint *info
|
||||
) {
|
||||
RELAPACK_dpbtrf(uplo, n, kd, Ab, ldAb, info);
|
||||
}
|
||||
|
|
@ -206,9 +206,9 @@ void LAPACK(dpbtrf)(
|
|||
|
||||
#if INCLUDE_CPBTRF
|
||||
void LAPACK(cpbtrf)(
|
||||
const char *uplo, const int *n, const int *kd,
|
||||
float *Ab, const int *ldAb,
|
||||
int *info
|
||||
const char *uplo, const blasint *n, const blasint *kd,
|
||||
float *Ab, const blasint *ldAb,
|
||||
blasint *info
|
||||
) {
|
||||
RELAPACK_cpbtrf(uplo, n, kd, Ab, ldAb, info);
|
||||
}
|
||||
|
|
@ -216,9 +216,9 @@ void LAPACK(cpbtrf)(
|
|||
|
||||
#if INCLUDE_ZPBTRF
|
||||
void LAPACK(zpbtrf)(
|
||||
const char *uplo, const int *n, const int *kd,
|
||||
double *Ab, const int *ldAb,
|
||||
int *info
|
||||
const char *uplo, const blasint *n, const blasint *kd,
|
||||
double *Ab, const blasint *ldAb,
|
||||
blasint *info
|
||||
) {
|
||||
RELAPACK_zpbtrf(uplo, n, kd, Ab, ldAb, info);
|
||||
}
|
||||
|
|
@ -231,9 +231,9 @@ void LAPACK(zpbtrf)(
|
|||
|
||||
#if INCLUDE_SSYTRF
|
||||
void LAPACK(ssytrf)(
|
||||
const char *uplo, const int *n,
|
||||
float *A, const int *ldA, int *ipiv,
|
||||
float *Work, const int *lWork, int *info
|
||||
const char *uplo, const blasint *n,
|
||||
float *A, const blasint *ldA, blasint *ipiv,
|
||||
float *Work, const blasint *lWork, blasint *info
|
||||
) {
|
||||
RELAPACK_ssytrf(uplo, n, A, ldA, ipiv, Work, lWork, info);
|
||||
}
|
||||
|
|
@ -241,9 +241,9 @@ void LAPACK(ssytrf)(
|
|||
|
||||
#if INCLUDE_DSYTRF
|
||||
void LAPACK(dsytrf)(
|
||||
const char *uplo, const int *n,
|
||||
double *A, const int *ldA, int *ipiv,
|
||||
double *Work, const int *lWork, int *info
|
||||
const char *uplo, const blasint *n,
|
||||
double *A, const blasint *ldA, blasint *ipiv,
|
||||
double *Work, const blasint *lWork, blasint *info
|
||||
) {
|
||||
RELAPACK_dsytrf(uplo, n, A, ldA, ipiv, Work, lWork, info);
|
||||
}
|
||||
|
|
@ -251,9 +251,9 @@ void LAPACK(dsytrf)(
|
|||
|
||||
#if INCLUDE_CSYTRF
|
||||
void LAPACK(csytrf)(
|
||||
const char *uplo, const int *n,
|
||||
float *A, const int *ldA, int *ipiv,
|
||||
float *Work, const int *lWork, int *info
|
||||
const char *uplo, const blasint *n,
|
||||
float *A, const blasint *ldA, blasint *ipiv,
|
||||
float *Work, const blasint *lWork, blasint *info
|
||||
) {
|
||||
RELAPACK_csytrf(uplo, n, A, ldA, ipiv, Work, lWork, info);
|
||||
}
|
||||
|
|
@ -261,9 +261,9 @@ void LAPACK(csytrf)(
|
|||
|
||||
#if INCLUDE_ZSYTRF
|
||||
void LAPACK(zsytrf)(
|
||||
const char *uplo, const int *n,
|
||||
double *A, const int *ldA, int *ipiv,
|
||||
double *Work, const int *lWork, int *info
|
||||
const char *uplo, const blasint *n,
|
||||
double *A, const blasint *ldA, blasint *ipiv,
|
||||
double *Work, const blasint *lWork, blasint *info
|
||||
) {
|
||||
RELAPACK_zsytrf(uplo, n, A, ldA, ipiv, Work, lWork, info);
|
||||
}
|
||||
|
|
@ -271,9 +271,9 @@ void LAPACK(zsytrf)(
|
|||
|
||||
#if INCLUDE_CHETRF
|
||||
void LAPACK(chetrf)(
|
||||
const char *uplo, const int *n,
|
||||
float *A, const int *ldA, int *ipiv,
|
||||
float *Work, const int *lWork, int *info
|
||||
const char *uplo, const blasint *n,
|
||||
float *A, const blasint *ldA, blasint *ipiv,
|
||||
float *Work, const blasint *lWork, blasint *info
|
||||
) {
|
||||
RELAPACK_chetrf(uplo, n, A, ldA, ipiv, Work, lWork, info);
|
||||
}
|
||||
|
|
@ -281,9 +281,9 @@ void LAPACK(chetrf)(
|
|||
|
||||
#if INCLUDE_ZHETRF
|
||||
void LAPACK(zhetrf)(
|
||||
const char *uplo, const int *n,
|
||||
double *A, const int *ldA, int *ipiv,
|
||||
double *Work, const int *lWork, int *info
|
||||
const char *uplo, const blasint *n,
|
||||
double *A, const blasint *ldA, blasint *ipiv,
|
||||
double *Work, const blasint *lWork, blasint *info
|
||||
) {
|
||||
RELAPACK_zhetrf(uplo, n, A, ldA, ipiv, Work, lWork, info);
|
||||
}
|
||||
|
|
@ -291,9 +291,9 @@ void LAPACK(zhetrf)(
|
|||
|
||||
#if INCLUDE_SSYTRF_ROOK
|
||||
void LAPACK(ssytrf_rook)(
|
||||
const char *uplo, const int *n,
|
||||
float *A, const int *ldA, int *ipiv,
|
||||
float *Work, const int *lWork, int *info
|
||||
const char *uplo, const blasint *n,
|
||||
float *A, const blasint *ldA, blasint *ipiv,
|
||||
float *Work, const blasint *lWork, blasint *info
|
||||
) {
|
||||
RELAPACK_ssytrf_rook(uplo, n, A, ldA, ipiv, Work, lWork, info);
|
||||
}
|
||||
|
|
@ -301,9 +301,9 @@ void LAPACK(ssytrf_rook)(
|
|||
|
||||
#if INCLUDE_DSYTRF_ROOK
|
||||
void LAPACK(dsytrf_rook)(
|
||||
const char *uplo, const int *n,
|
||||
double *A, const int *ldA, int *ipiv,
|
||||
double *Work, const int *lWork, int *info
|
||||
const char *uplo, const blasint *n,
|
||||
double *A, const blasint *ldA, blasint *ipiv,
|
||||
double *Work, const blasint *lWork, blasint *info
|
||||
) {
|
||||
RELAPACK_dsytrf_rook(uplo, n, A, ldA, ipiv, Work, lWork, info);
|
||||
}
|
||||
|
|
@ -311,9 +311,9 @@ void LAPACK(dsytrf_rook)(
|
|||
|
||||
#if INCLUDE_CSYTRF_ROOK
|
||||
void LAPACK(csytrf_rook)(
|
||||
const char *uplo, const int *n,
|
||||
float *A, const int *ldA, int *ipiv,
|
||||
float *Work, const int *lWork, int *info
|
||||
const char *uplo, const blasint *n,
|
||||
float *A, const blasint *ldA, blasint *ipiv,
|
||||
float *Work, const blasint *lWork, blasint *info
|
||||
) {
|
||||
RELAPACK_csytrf_rook(uplo, n, A, ldA, ipiv, Work, lWork, info);
|
||||
}
|
||||
|
|
@ -321,9 +321,9 @@ void LAPACK(csytrf_rook)(
|
|||
|
||||
#if INCLUDE_ZSYTRF_ROOK
|
||||
void LAPACK(zsytrf_rook)(
|
||||
const char *uplo, const int *n,
|
||||
double *A, const int *ldA, int *ipiv,
|
||||
double *Work, const int *lWork, int *info
|
||||
const char *uplo, const blasint *n,
|
||||
double *A, const blasint *ldA, blasint *ipiv,
|
||||
double *Work, const blasint *lWork, blasint *info
|
||||
) {
|
||||
RELAPACK_zsytrf_rook(uplo, n, A, ldA, ipiv, Work, lWork, info);
|
||||
}
|
||||
|
|
@ -331,9 +331,9 @@ void LAPACK(zsytrf_rook)(
|
|||
|
||||
#if INCLUDE_CHETRF_ROOK
|
||||
void LAPACK(chetrf_rook)(
|
||||
const char *uplo, const int *n,
|
||||
float *A, const int *ldA, int *ipiv,
|
||||
float *Work, const int *lWork, int *info
|
||||
const char *uplo, const blasint *n,
|
||||
float *A, const blasint *ldA, blasint *ipiv,
|
||||
float *Work, const blasint *lWork, blasint *info
|
||||
) {
|
||||
RELAPACK_chetrf_rook(uplo, n, A, ldA, ipiv, Work, lWork, info);
|
||||
}
|
||||
|
|
@ -341,9 +341,9 @@ void LAPACK(chetrf_rook)(
|
|||
|
||||
#if INCLUDE_ZHETRF_ROOK
|
||||
void LAPACK(zhetrf_rook)(
|
||||
const char *uplo, const int *n,
|
||||
double *A, const int *ldA, int *ipiv,
|
||||
double *Work, const int *lWork, int *info
|
||||
const char *uplo, const blasint *n,
|
||||
double *A, const blasint *ldA, blasint *ipiv,
|
||||
double *Work, const blasint *lWork, blasint *info
|
||||
) {
|
||||
RELAPACK_zhetrf_rook(uplo, n, A, ldA, ipiv, Work, lWork, info);
|
||||
}
|
||||
|
|
@ -356,9 +356,9 @@ void LAPACK(zhetrf_rook)(
|
|||
|
||||
#if INCLUDE_SGETRF
|
||||
void LAPACK(sgetrf)(
|
||||
const int *m, const int *n,
|
||||
float *A, const int *ldA, int *ipiv,
|
||||
int *info
|
||||
const blasint *m, const blasint *n,
|
||||
float *A, const blasint *ldA, blasint *ipiv,
|
||||
blasint *info
|
||||
) {
|
||||
RELAPACK_sgetrf(m, n, A, ldA, ipiv, info);
|
||||
}
|
||||
|
|
@ -366,9 +366,9 @@ void LAPACK(sgetrf)(
|
|||
|
||||
#if INCLUDE_DGETRF
|
||||
void LAPACK(dgetrf)(
|
||||
const int *m, const int *n,
|
||||
double *A, const int *ldA, int *ipiv,
|
||||
int *info
|
||||
const blasint *m, const blasint *n,
|
||||
double *A, const blasint *ldA, blasint *ipiv,
|
||||
blasint *info
|
||||
) {
|
||||
RELAPACK_dgetrf(m, n, A, ldA, ipiv, info);
|
||||
}
|
||||
|
|
@ -376,9 +376,9 @@ void LAPACK(dgetrf)(
|
|||
|
||||
#if INCLUDE_CGETRF
|
||||
void LAPACK(cgetrf)(
|
||||
const int *m, const int *n,
|
||||
float *A, const int *ldA, int *ipiv,
|
||||
int *info
|
||||
const blasint *m, const blasint *n,
|
||||
float *A, const blasint *ldA, blasint *ipiv,
|
||||
blasint *info
|
||||
) {
|
||||
RELAPACK_cgetrf(m, n, A, ldA, ipiv, info);
|
||||
}
|
||||
|
|
@ -386,9 +386,9 @@ void LAPACK(cgetrf)(
|
|||
|
||||
#if INCLUDE_ZGETRF
|
||||
void LAPACK(zgetrf)(
|
||||
const int *m, const int *n,
|
||||
double *A, const int *ldA, int *ipiv,
|
||||
int *info
|
||||
const blasint *m, const blasint *n,
|
||||
double *A, const blasint *ldA, blasint *ipiv,
|
||||
blasint *info
|
||||
) {
|
||||
RELAPACK_zgetrf(m, n, A, ldA, ipiv, info);
|
||||
}
|
||||
|
|
@ -401,9 +401,9 @@ void LAPACK(zgetrf)(
|
|||
|
||||
#if INCLUDE_SGBTRF
|
||||
void LAPACK(sgbtrf)(
|
||||
const int *m, const int *n, const int *kl, const int *ku,
|
||||
float *Ab, const int *ldAb, int *ipiv,
|
||||
int *info
|
||||
const blasint *m, const blasint *n, const blasint *kl, const blasint *ku,
|
||||
float *Ab, const blasint *ldAb, blasint *ipiv,
|
||||
blasint *info
|
||||
) {
|
||||
RELAPACK_sgbtrf(m, n, kl, ku, Ab, ldAb, ipiv, info);
|
||||
}
|
||||
|
|
@ -411,9 +411,9 @@ void LAPACK(sgbtrf)(
|
|||
|
||||
#if INCLUDE_DGBTRF
|
||||
void LAPACK(dgbtrf)(
|
||||
const int *m, const int *n, const int *kl, const int *ku,
|
||||
double *Ab, const int *ldAb, int *ipiv,
|
||||
int *info
|
||||
const blasint *m, const blasint *n, const blasint *kl, const blasint *ku,
|
||||
double *Ab, const blasint *ldAb, blasint *ipiv,
|
||||
blasint *info
|
||||
) {
|
||||
RELAPACK_dgbtrf(m, n, kl, ku, Ab, ldAb, ipiv, info);
|
||||
}
|
||||
|
|
@ -421,9 +421,9 @@ void LAPACK(dgbtrf)(
|
|||
|
||||
#if INCLUDE_CGBTRF
|
||||
void LAPACK(cgbtrf)(
|
||||
const int *m, const int *n, const int *kl, const int *ku,
|
||||
float *Ab, const int *ldAb, int *ipiv,
|
||||
int *info
|
||||
const blasint *m, const blasint *n, const blasint *kl, const blasint *ku,
|
||||
float *Ab, const blasint *ldAb, blasint *ipiv,
|
||||
blasint *info
|
||||
) {
|
||||
RELAPACK_cgbtrf(m, n, kl, ku, Ab, ldAb, ipiv, info);
|
||||
}
|
||||
|
|
@ -431,9 +431,9 @@ void LAPACK(cgbtrf)(
|
|||
|
||||
#if INCLUDE_ZGBTRF
|
||||
void LAPACK(zgbtrf)(
|
||||
const int *m, const int *n, const int *kl, const int *ku,
|
||||
double *Ab, const int *ldAb, int *ipiv,
|
||||
int *info
|
||||
const blasint *m, const blasint *n, const blasint *kl, const blasint *ku,
|
||||
double *Ab, const blasint *ldAb, blasint *ipiv,
|
||||
blasint *info
|
||||
) {
|
||||
RELAPACK_zgbtrf(m, n, kl, ku, Ab, ldAb, ipiv, info);
|
||||
}
|
||||
|
|
@ -446,11 +446,11 @@ void LAPACK(zgbtrf)(
|
|||
|
||||
#if INCLUDE_STRSYL
|
||||
void LAPACK(strsyl)(
|
||||
const char *tranA, const char *tranB, const int *isgn,
|
||||
const int *m, const int *n,
|
||||
const float *A, const int *ldA, const float *B, const int *ldB,
|
||||
float *C, const int *ldC, float *scale,
|
||||
int *info
|
||||
const char *tranA, const char *tranB, const blasint *isgn,
|
||||
const blasint *m, const blasint *n,
|
||||
const float *A, const blasint *ldA, const float *B, const blasint *ldB,
|
||||
float *C, const blasint *ldC, float *scale,
|
||||
blasint *info
|
||||
) {
|
||||
RELAPACK_strsyl(tranA, tranB, isgn, m, n, A, ldA, B, ldB, C, ldC, scale, info);
|
||||
}
|
||||
|
|
@ -458,11 +458,11 @@ void LAPACK(strsyl)(
|
|||
|
||||
#if INCLUDE_DTRSYL
|
||||
void LAPACK(dtrsyl)(
|
||||
const char *tranA, const char *tranB, const int *isgn,
|
||||
const int *m, const int *n,
|
||||
const double *A, const int *ldA, const double *B, const int *ldB,
|
||||
double *C, const int *ldC, double *scale,
|
||||
int *info
|
||||
const char *tranA, const char *tranB, const blasint *isgn,
|
||||
const blasint *m, const blasint *n,
|
||||
const double *A, const blasint *ldA, const double *B, const blasint *ldB,
|
||||
double *C, const blasint *ldC, double *scale,
|
||||
blasint *info
|
||||
) {
|
||||
RELAPACK_dtrsyl(tranA, tranB, isgn, m, n, A, ldA, B, ldB, C, ldC, scale, info);
|
||||
}
|
||||
|
|
@ -470,11 +470,11 @@ void LAPACK(dtrsyl)(
|
|||
|
||||
#if INCLUDE_CTRSYL
|
||||
void LAPACK(ctrsyl)(
|
||||
const char *tranA, const char *tranB, const int *isgn,
|
||||
const int *m, const int *n,
|
||||
const float *A, const int *ldA, const float *B, const int *ldB,
|
||||
float *C, const int *ldC, float *scale,
|
||||
int *info
|
||||
const char *tranA, const char *tranB, const blasint *isgn,
|
||||
const blasint *m, const blasint *n,
|
||||
const float *A, const blasint *ldA, const float *B, const blasint *ldB,
|
||||
float *C, const blasint *ldC, float *scale,
|
||||
blasint *info
|
||||
) {
|
||||
RELAPACK_ctrsyl(tranA, tranB, isgn, m, n, A, ldA, B, ldB, C, ldC, scale, info);
|
||||
}
|
||||
|
|
@ -482,11 +482,11 @@ void LAPACK(ctrsyl)(
|
|||
|
||||
#if INCLUDE_ZTRSYL
|
||||
void LAPACK(ztrsyl)(
|
||||
const char *tranA, const char *tranB, const int *isgn,
|
||||
const int *m, const int *n,
|
||||
const double *A, const int *ldA, const double *B, const int *ldB,
|
||||
double *C, const int *ldC, double *scale,
|
||||
int *info
|
||||
const char *tranA, const char *tranB, const blasint *isgn,
|
||||
const blasint *m, const blasint *n,
|
||||
const double *A, const blasint *ldA, const double *B, const blasint *ldB,
|
||||
double *C, const blasint *ldC, double *scale,
|
||||
blasint *info
|
||||
) {
|
||||
RELAPACK_ztrsyl(tranA, tranB, isgn, m, n, A, ldA, B, ldB, C, ldC, scale, info);
|
||||
}
|
||||
|
|
@ -499,13 +499,13 @@ void LAPACK(ztrsyl)(
|
|||
|
||||
#if INCLUDE_STGSYL
|
||||
void LAPACK(stgsyl)(
|
||||
const char *trans, const int *ijob, const int *m, const int *n,
|
||||
const float *A, const int *ldA, const float *B, const int *ldB,
|
||||
float *C, const int *ldC,
|
||||
const float *D, const int *ldD, const float *E, const int *ldE,
|
||||
float *F, const int *ldF,
|
||||
const char *trans, const blasint *ijob, const blasint *m, const blasint *n,
|
||||
const float *A, const blasint *ldA, const float *B, const blasint *ldB,
|
||||
float *C, const blasint *ldC,
|
||||
const float *D, const blasint *ldD, const float *E, const blasint *ldE,
|
||||
float *F, const blasint *ldF,
|
||||
float *scale, float *dif,
|
||||
float *Work, const int *lWork, int *iWork, int *info
|
||||
float *Work, const blasint *lWork, blasint *iWork, blasint *info
|
||||
) {
|
||||
RELAPACK_stgsyl(trans, ijob, m, n, A, ldA, B, ldB, C, ldC, D, ldD, E, ldE, F, ldF, scale, dif, Work, lWork, iWork, info);
|
||||
}
|
||||
|
|
@ -513,13 +513,13 @@ void LAPACK(stgsyl)(
|
|||
|
||||
#if INCLUDE_DTGSYL
|
||||
void LAPACK(dtgsyl)(
|
||||
const char *trans, const int *ijob, const int *m, const int *n,
|
||||
const double *A, const int *ldA, const double *B, const int *ldB,
|
||||
double *C, const int *ldC,
|
||||
const double *D, const int *ldD, const double *E, const int *ldE,
|
||||
double *F, const int *ldF,
|
||||
const char *trans, const blasint *ijob, const blasint *m, const blasint *n,
|
||||
const double *A, const blasint *ldA, const double *B, const blasint *ldB,
|
||||
double *C, const blasint *ldC,
|
||||
const double *D, const blasint *ldD, const double *E, const blasint *ldE,
|
||||
double *F, const blasint *ldF,
|
||||
double *scale, double *dif,
|
||||
double *Work, const int *lWork, int *iWork, int *info
|
||||
double *Work, const blasint *lWork, blasint *iWork, blasint *info
|
||||
) {
|
||||
RELAPACK_dtgsyl(trans, ijob, m, n, A, ldA, B, ldB, C, ldC, D, ldD, E, ldE, F, ldF, scale, dif, Work, lWork, iWork, info);
|
||||
}
|
||||
|
|
@ -527,13 +527,13 @@ void LAPACK(dtgsyl)(
|
|||
|
||||
#if INCLUDE_CTGSYL
|
||||
void LAPACK(ctgsyl)(
|
||||
const char *trans, const int *ijob, const int *m, const int *n,
|
||||
const float *A, const int *ldA, const float *B, const int *ldB,
|
||||
float *C, const int *ldC,
|
||||
const float *D, const int *ldD, const float *E, const int *ldE,
|
||||
float *F, const int *ldF,
|
||||
const char *trans, const blasint *ijob, const blasint *m, const blasint *n,
|
||||
const float *A, const blasint *ldA, const float *B, const blasint *ldB,
|
||||
float *C, const blasint *ldC,
|
||||
const float *D, const blasint *ldD, const float *E, const blasint *ldE,
|
||||
float *F, const blasint *ldF,
|
||||
float *scale, float *dif,
|
||||
float *Work, const int *lWork, int *iWork, int *info
|
||||
float *Work, const blasint *lWork, blasint *iWork, blasint *info
|
||||
) {
|
||||
RELAPACK_ctgsyl(trans, ijob, m, n, A, ldA, B, ldB, C, ldC, D, ldD, E, ldE, F, ldF, scale, dif, Work, lWork, iWork, info);
|
||||
}
|
||||
|
|
@ -541,13 +541,13 @@ void LAPACK(ctgsyl)(
|
|||
|
||||
#if INCLUDE_ZTGSYL
|
||||
void LAPACK(ztgsyl)(
|
||||
const char *trans, const int *ijob, const int *m, const int *n,
|
||||
const double *A, const int *ldA, const double *B, const int *ldB,
|
||||
double *C, const int *ldC,
|
||||
const double *D, const int *ldD, const double *E, const int *ldE,
|
||||
double *F, const int *ldF,
|
||||
const char *trans, const blasint *ijob, const blasint *m, const blasint *n,
|
||||
const double *A, const blasint *ldA, const double *B, const blasint *ldB,
|
||||
double *C, const blasint *ldC,
|
||||
const double *D, const blasint *ldD, const double *E, const blasint *ldE,
|
||||
double *F, const blasint *ldF,
|
||||
double *scale, double *dif,
|
||||
double *Work, const int *lWork, int *iWork, int *info
|
||||
double *Work, const blasint *lWork, blasint *iWork, blasint *info
|
||||
) {
|
||||
RELAPACK_ztgsyl(trans, ijob, m, n, A, ldA, B, ldB, C, ldC, D, ldD, E, ldE, F, ldF, scale, dif, Work, lWork, iWork, info);
|
||||
}
|
||||
|
|
@ -561,10 +561,10 @@ void LAPACK(ztgsyl)(
|
|||
#if INCLUDE_SGEMMT
|
||||
void LAPACK(sgemmt)(
|
||||
const char *uplo, const char *transA, const char *transB,
|
||||
const int *n, const int *k,
|
||||
const float *alpha, const float *A, const int *ldA,
|
||||
const float *B, const int *ldB,
|
||||
const float *beta, float *C, const int *ldC
|
||||
const blasint *n, const blasint *k,
|
||||
const float *alpha, const float *A, const blasint *ldA,
|
||||
const float *B, const blasint *ldB,
|
||||
const float *beta, float *C, const blasint *ldC
|
||||
) {
|
||||
RELAPACK_sgemmt(uplo, n, A, ldA, info);
|
||||
}
|
||||
|
|
@ -573,10 +573,10 @@ void LAPACK(sgemmt)(
|
|||
#if INCLUDE_DGEMMT
|
||||
void LAPACK(dgemmt)(
|
||||
const char *uplo, const char *transA, const char *transB,
|
||||
const int *n, const int *k,
|
||||
const double *alpha, const double *A, const int *ldA,
|
||||
const double *B, const int *ldB,
|
||||
const double *beta, double *C, const int *ldC
|
||||
const blasint *n, const blasint *k,
|
||||
const double *alpha, const double *A, const blasint *ldA,
|
||||
const double *B, const blasint *ldB,
|
||||
const double *beta, double *C, const blasint *ldC
|
||||
) {
|
||||
RELAPACK_dgemmt(uplo, n, A, ldA, info);
|
||||
}
|
||||
|
|
@ -585,10 +585,10 @@ void LAPACK(dgemmt)(
|
|||
#if INCLUDE_CGEMMT
|
||||
void LAPACK(cgemmt)(
|
||||
const char *uplo, const char *transA, const char *transB,
|
||||
const int *n, const int *k,
|
||||
const float *alpha, const float *A, const int *ldA,
|
||||
const float *B, const int *ldB,
|
||||
const float *beta, float *C, const int *ldC
|
||||
const blasint *n, const blasint *k,
|
||||
const float *alpha, const float *A, const blasint *ldA,
|
||||
const float *B, const blasint *ldB,
|
||||
const float *beta, float *C, const blasint *ldC
|
||||
) {
|
||||
RELAPACK_cgemmt(uplo, n, A, ldA, info);
|
||||
}
|
||||
|
|
@ -597,10 +597,10 @@ void LAPACK(cgemmt)(
|
|||
#if INCLUDE_ZGEMMT
|
||||
void LAPACK(zgemmt)(
|
||||
const char *uplo, const char *transA, const char *transB,
|
||||
const int *n, const int *k,
|
||||
const double *alpha, const double *A, const int *ldA,
|
||||
const double *B, const int *ldB,
|
||||
const double *beta, double *C, const int *ldC
|
||||
const blasint *n, const blasint *k,
|
||||
const double *alpha, const double *A, const blasint *ldA,
|
||||
const double *B, const blasint *ldB,
|
||||
const double *beta, double *C, const blasint *ldC
|
||||
) {
|
||||
RELAPACK_zgemmt(uplo, n, A, ldA, info);
|
||||
}
|
||||
|
|
|
|||
|
|
@ -1,6 +1,14 @@
|
|||
#ifndef RELAPACK_INT_H
|
||||
#define RELAPACK_INT_H
|
||||
|
||||
#include <string.h>
|
||||
#include "../../config.h"
|
||||
#if defined(OS_WINDOWS) && defined(__64BIT__)
|
||||
typedef long long BLASLONG;
|
||||
typedef unsigned long long BLASULONG;
|
||||
#else
|
||||
typedef long BLASLONG;
|
||||
typedef unsigned long BLASULONG;
|
||||
#endif
|
||||
#include "../config.h"
|
||||
|
||||
#include "../inc/relapack.h"
|
||||
|
|
@ -38,23 +46,23 @@
|
|||
#include "blas.h"
|
||||
|
||||
// sytrf helper routines
|
||||
void RELAPACK_ssytrf_rec2(const char *, const int *, const int *, int *, float *, const int *, int *, float *, const int *, int *);
|
||||
void RELAPACK_dsytrf_rec2(const char *, const int *, const int *, int *, double *, const int *, int *, double *, const int *, int *);
|
||||
void RELAPACK_csytrf_rec2(const char *, const int *, const int *, int *, float *, const int *, int *, float *, const int *, int *);
|
||||
void RELAPACK_chetrf_rec2(const char *, const int *, const int *, int *, float *, const int *, int *, float *, const int *, int *);
|
||||
void RELAPACK_zsytrf_rec2(const char *, const int *, const int *, int *, double *, const int *, int *, double *, const int *, int *);
|
||||
void RELAPACK_zhetrf_rec2(const char *, const int *, const int *, int *, double *, const int *, int *, double *, const int *, int *);
|
||||
void RELAPACK_ssytrf_rook_rec2(const char *, const int *, const int *, int *, float *, const int *, int *, float *, const int *, int *);
|
||||
void RELAPACK_dsytrf_rook_rec2(const char *, const int *, const int *, int *, double *, const int *, int *, double *, const int *, int *);
|
||||
void RELAPACK_csytrf_rook_rec2(const char *, const int *, const int *, int *, float *, const int *, int *, float *, const int *, int *);
|
||||
void RELAPACK_chetrf_rook_rec2(const char *, const int *, const int *, int *, float *, const int *, int *, float *, const int *, int *);
|
||||
void RELAPACK_zsytrf_rook_rec2(const char *, const int *, const int *, int *, double *, const int *, int *, double *, const int *, int *);
|
||||
void RELAPACK_zhetrf_rook_rec2(const char *, const int *, const int *, int *, double *, const int *, int *, double *, const int *, int *);
|
||||
void RELAPACK_ssytrf_rec2(const char *, const blasint *, const blasint *, blasint *, float *, const blasint *, blasint *, float *, const blasint *, blasint *);
|
||||
void RELAPACK_dsytrf_rec2(const char *, const blasint *, const blasint *, blasint *, double *, const blasint *, blasint *, double *, const blasint *, blasint *);
|
||||
void RELAPACK_csytrf_rec2(const char *, const blasint *, const blasint *, blasint *, float *, const blasint *, blasint *, float *, const blasint *, blasint *);
|
||||
void RELAPACK_chetrf_rec2(const char *, const blasint *, const blasint *, blasint *, float *, const blasint *, blasint *, float *, const blasint *, blasint *);
|
||||
void RELAPACK_zsytrf_rec2(const char *, const blasint *, const blasint *, blasint *, double *, const blasint *, blasint *, double *, const blasint *, blasint *);
|
||||
void RELAPACK_zhetrf_rec2(const char *, const blasint *, const blasint *, blasint *, double *, const blasint *, blasint *, double *, const blasint *, blasint *);
|
||||
void RELAPACK_ssytrf_rook_rec2(const char *, const blasint *, const blasint *, blasint *, float *, const blasint *, blasint *, float *, const blasint *, blasint *);
|
||||
void RELAPACK_dsytrf_rook_rec2(const char *, const blasint *, const blasint *, blasint *, double *, const blasint *, blasint *, double *, const blasint *, blasint *);
|
||||
void RELAPACK_csytrf_rook_rec2(const char *, const blasint *, const blasint *, blasint *, float *, const blasint *, blasint *, float *, const blasint *, blasint *);
|
||||
void RELAPACK_chetrf_rook_rec2(const char *, const blasint *, const blasint *, blasint *, float *, const blasint *, blasint *, float *, const blasint *, blasint *);
|
||||
void RELAPACK_zsytrf_rook_rec2(const char *, const blasint *, const blasint *, blasint *, double *, const blasint *, blasint *, double *, const blasint *, blasint *);
|
||||
void RELAPACK_zhetrf_rook_rec2(const char *, const blasint *, const blasint *, blasint *, double *, const blasint *, blasint *, double *, const blasint *, blasint *);
|
||||
|
||||
// trsyl helper routines
|
||||
void RELAPACK_strsyl_rec2(const char *, const char *, const int *, const int *, const int *, const float *, const int *, const float *, const int *, float *, const int *, float *, int *);
|
||||
void RELAPACK_dtrsyl_rec2(const char *, const char *, const int *, const int *, const int *, const double *, const int *, const double *, const int *, double *, const int *, double *, int *);
|
||||
void RELAPACK_ctrsyl_rec2(const char *, const char *, const int *, const int *, const int *, const float *, const int *, const float *, const int *, float *, const int *, float *, int *);
|
||||
void RELAPACK_ztrsyl_rec2(const char *, const char *, const int *, const int *, const int *, const double *, const int *, const double *, const int *, double *, const int *, double *, int *);
|
||||
void RELAPACK_strsyl_rec2(const char *, const char *, const blasint *, const blasint *, const blasint *, const float *, const blasint *, const float *, const blasint *, float *, const blasint *, float *, blasint *);
|
||||
void RELAPACK_dtrsyl_rec2(const char *, const char *, const blasint *, const blasint *, const blasint *, const double *, const blasint *, const double *, const blasint *, double *, const blasint *, double *, blasint *);
|
||||
void RELAPACK_ctrsyl_rec2(const char *, const char *, const blasint *, const blasint *, const blasint *, const float *, const blasint *, const float *, const blasint *, float *, const blasint *, float *, blasint *);
|
||||
void RELAPACK_ztrsyl_rec2(const char *, const char *, const blasint *, const blasint *, const blasint *, const double *, const blasint *, const double *, const blasint *, double *, const blasint *, double *, blasint *);
|
||||
|
||||
#endif /* RELAPACK_INT_H */
|
||||
|
|
|
|||
|
|
@ -1,9 +1,9 @@
|
|||
#include "relapack.h"
|
||||
#include "stdlib.h"
|
||||
|
||||
static void RELAPACK_sgbtrf_rec(const int *, const int *, const int *,
|
||||
const int *, float *, const int *, int *, float *, const int *, float *,
|
||||
const int *, int *);
|
||||
static void RELAPACK_sgbtrf_rec(const blasint *, const blasint *, const blasint *,
|
||||
const blasint *, float *, const blasint *, blasint *, float *, const blasint *, float *,
|
||||
const blasint *, blasint *);
|
||||
|
||||
|
||||
/** SGBTRF computes an LU factorization of a real m-by-n band matrix A using partial pivoting with row interchanges.
|
||||
|
|
@ -13,11 +13,10 @@ static void RELAPACK_sgbtrf_rec(const int *, const int *, const int *,
|
|||
* http://www.netlib.org/lapack/explore-html/d5/d72/sgbtrf_8f.html
|
||||
* */
|
||||
void RELAPACK_sgbtrf(
|
||||
const int *m, const int *n, const int *kl, const int *ku,
|
||||
float *Ab, const int *ldAb, int *ipiv,
|
||||
int *info
|
||||
const blasint *m, const blasint *n, const blasint *kl, const blasint *ku,
|
||||
float *Ab, const blasint *ldAb, blasint *ipiv,
|
||||
blasint *info
|
||||
) {
|
||||
|
||||
// Check arguments
|
||||
*info = 0;
|
||||
if (*m < 0)
|
||||
|
|
@ -31,8 +30,8 @@ void RELAPACK_sgbtrf(
|
|||
else if (*ldAb < 2 * *kl + *ku + 1)
|
||||
*info = -6;
|
||||
if (*info) {
|
||||
const int minfo = -*info;
|
||||
LAPACK(xerbla)("SGBTRF", &minfo);
|
||||
const blasint minfo = -*info;
|
||||
LAPACK(xerbla)("SGBTRF", &minfo, strlen("SGBTRF"));
|
||||
return;
|
||||
}
|
||||
|
||||
|
|
@ -40,14 +39,14 @@ void RELAPACK_sgbtrf(
|
|||
const float ZERO[] = { 0. };
|
||||
|
||||
// Result upper band width
|
||||
const int kv = *ku + *kl;
|
||||
const blasint kv = *ku + *kl;
|
||||
|
||||
// Unskewg A
|
||||
const int ldA[] = { *ldAb - 1 };
|
||||
const blasint ldA[] = { *ldAb - 1 };
|
||||
float *const A = Ab + kv;
|
||||
|
||||
// Zero upper diagonal fill-in elements
|
||||
int i, j;
|
||||
blasint i, j;
|
||||
for (j = 0; j < *n; j++) {
|
||||
float *const A_j = A + *ldA * j;
|
||||
for (i = MAX(0, j - kv); i < j - *ku; i++)
|
||||
|
|
@ -55,11 +54,11 @@ void RELAPACK_sgbtrf(
|
|||
}
|
||||
|
||||
// Allocate work space
|
||||
const int n1 = SREC_SPLIT(*n);
|
||||
const int mWorkl = (kv > n1) ? MAX(1, *m - *kl) : kv;
|
||||
const int nWorkl = (kv > n1) ? n1 : kv;
|
||||
const int mWorku = (*kl > n1) ? n1 : *kl;
|
||||
const int nWorku = (*kl > n1) ? MAX(0, *n - *kl) : *kl;
|
||||
const blasint n1 = SREC_SPLIT(*n);
|
||||
const blasint mWorkl = (kv > n1) ? MAX(1, *m - *kl) : kv;
|
||||
const blasint nWorkl = (kv > n1) ? n1 : kv;
|
||||
const blasint mWorku = (*kl > n1) ? n1 : *kl;
|
||||
const blasint nWorku = (*kl > n1) ? MAX(0, *n - *kl) : *kl;
|
||||
float *Workl = malloc(mWorkl * nWorkl * sizeof(float));
|
||||
float *Worku = malloc(mWorku * nWorku * sizeof(float));
|
||||
LAPACK(slaset)("L", &mWorkl, &nWorkl, ZERO, ZERO, Workl, &mWorkl);
|
||||
|
|
@ -76,10 +75,10 @@ void RELAPACK_sgbtrf(
|
|||
|
||||
/** sgbtrf's recursive compute kernel */
|
||||
static void RELAPACK_sgbtrf_rec(
|
||||
const int *m, const int *n, const int *kl, const int *ku,
|
||||
float *Ab, const int *ldAb, int *ipiv,
|
||||
float *Workl, const int *ldWorkl, float *Worku, const int *ldWorku,
|
||||
int *info
|
||||
const blasint *m, const blasint *n, const blasint *kl, const blasint *ku,
|
||||
float *Ab, const blasint *ldAb, blasint *ipiv,
|
||||
float *Workl, const blasint *ldWorkl, float *Worku, const blasint *ldWorku,
|
||||
blasint *info
|
||||
) {
|
||||
|
||||
if (*n <= MAX(CROSSOVER_SGBTRF, 1)) {
|
||||
|
|
@ -91,25 +90,25 @@ static void RELAPACK_sgbtrf_rec(
|
|||
// Constants
|
||||
const float ONE[] = { 1. };
|
||||
const float MONE[] = { -1. };
|
||||
const int iONE[] = { 1 };
|
||||
const blasint iONE[] = { 1 };
|
||||
|
||||
// Loop iterators
|
||||
int i, j;
|
||||
blasint i, j;
|
||||
|
||||
// Output upper band width
|
||||
const int kv = *ku + *kl;
|
||||
const blasint kv = *ku + *kl;
|
||||
|
||||
// Unskew A
|
||||
const int ldA[] = { *ldAb - 1 };
|
||||
const blasint ldA[] = { *ldAb - 1 };
|
||||
float *const A = Ab + kv;
|
||||
|
||||
// Splitting
|
||||
const int n1 = MIN(SREC_SPLIT(*n), *kl);
|
||||
const int n2 = *n - n1;
|
||||
const int m1 = MIN(n1, *m);
|
||||
const int m2 = *m - m1;
|
||||
const int mn1 = MIN(m1, n1);
|
||||
const int mn2 = MIN(m2, n2);
|
||||
const blasint n1 = MIN(SREC_SPLIT(*n), *kl);
|
||||
const blasint n2 = *n - n1;
|
||||
const blasint m1 = MIN(n1, *m);
|
||||
const blasint m2 = *m - m1;
|
||||
const blasint mn1 = MIN(m1, n1);
|
||||
const blasint mn2 = MIN(m2, n2);
|
||||
|
||||
// Ab_L *
|
||||
// Ab_BR
|
||||
|
|
@ -129,14 +128,14 @@ static void RELAPACK_sgbtrf_rec(
|
|||
|
||||
// ipiv_T
|
||||
// ipiv_B
|
||||
int *const ipiv_T = ipiv;
|
||||
int *const ipiv_B = ipiv + n1;
|
||||
blasint *const ipiv_T = ipiv;
|
||||
blasint *const ipiv_B = ipiv + n1;
|
||||
|
||||
// Banded splitting
|
||||
const int n21 = MIN(n2, kv - n1);
|
||||
const int n22 = MIN(n2 - n21, n1);
|
||||
const int m21 = MIN(m2, *kl - m1);
|
||||
const int m22 = MIN(m2 - m21, m1);
|
||||
const blasint n21 = MIN(n2, kv - n1);
|
||||
const blasint n22 = MIN(n2 - n21, n1);
|
||||
const blasint m21 = MIN(m2, *kl - m1);
|
||||
const blasint m22 = MIN(m2 - m21, m1);
|
||||
|
||||
// n1 n21 n22
|
||||
// m * A_Rl ARr
|
||||
|
|
@ -164,7 +163,7 @@ static void RELAPACK_sgbtrf_rec(
|
|||
|
||||
// partially redo swaps in A_L
|
||||
for (i = 0; i < mn1; i++) {
|
||||
const int ip = ipiv_T[i] - 1;
|
||||
const blasint ip = ipiv_T[i] - 1;
|
||||
if (ip != i) {
|
||||
if (ip < *kl)
|
||||
BLAS(sswap)(&i, A_L + i, ldA, A_L + ip, ldA);
|
||||
|
|
@ -180,7 +179,7 @@ static void RELAPACK_sgbtrf_rec(
|
|||
for (j = 0; j < n22; j++) {
|
||||
float *const A_Rrj = A_Rr + *ldA * j;
|
||||
for (i = j; i < mn1; i++) {
|
||||
const int ip = ipiv_T[i] - 1;
|
||||
const blasint ip = ipiv_T[i] - 1;
|
||||
if (ip != i) {
|
||||
const float tmp = A_Rrj[i];
|
||||
A_Rrj[i] = A_Rr[ip];
|
||||
|
|
@ -208,7 +207,7 @@ static void RELAPACK_sgbtrf_rec(
|
|||
|
||||
// partially undo swaps in A_L
|
||||
for (i = mn1 - 1; i >= 0; i--) {
|
||||
const int ip = ipiv_T[i] - 1;
|
||||
const blasint ip = ipiv_T[i] - 1;
|
||||
if (ip != i) {
|
||||
if (ip < *kl)
|
||||
BLAS(sswap)(&i, A_L + i, ldA, A_L + ip, ldA);
|
||||
|
|
|
|||
|
|
@ -1,12 +1,12 @@
|
|||
#include "relapack.h"
|
||||
|
||||
static void RELAPACK_sgemmt_rec(const char *, const char *, const char *,
|
||||
const int *, const int *, const float *, const float *, const int *,
|
||||
const float *, const int *, const float *, float *, const int *);
|
||||
const blasint *, const blasint *, const float *, const float *, const blasint *,
|
||||
const float *, const blasint *, const float *, float *, const blasint *);
|
||||
|
||||
static void RELAPACK_sgemmt_rec2(const char *, const char *, const char *,
|
||||
const int *, const int *, const float *, const float *, const int *,
|
||||
const float *, const int *, const float *, float *, const int *);
|
||||
const blasint *, const blasint *, const float *, const float *, const blasint *,
|
||||
const float *, const blasint *, const float *, float *, const blasint *);
|
||||
|
||||
|
||||
/** SGEMMT computes a matrix-matrix product with general matrices but updates
|
||||
|
|
@ -20,10 +20,10 @@ static void RELAPACK_sgemmt_rec2(const char *, const char *, const char *,
|
|||
* */
|
||||
void RELAPACK_sgemmt(
|
||||
const char *uplo, const char *transA, const char *transB,
|
||||
const int *n, const int *k,
|
||||
const float *alpha, const float *A, const int *ldA,
|
||||
const float *B, const int *ldB,
|
||||
const float *beta, float *C, const int *ldC
|
||||
const blasint *n, const blasint *k,
|
||||
const float *alpha, const float *A, const blasint *ldA,
|
||||
const float *B, const blasint *ldB,
|
||||
const float *beta, float *C, const blasint *ldC
|
||||
) {
|
||||
|
||||
#if HAVE_XGEMMT
|
||||
|
|
@ -32,13 +32,13 @@ void RELAPACK_sgemmt(
|
|||
#else
|
||||
|
||||
// Check arguments
|
||||
const int lower = LAPACK(lsame)(uplo, "L");
|
||||
const int upper = LAPACK(lsame)(uplo, "U");
|
||||
const int notransA = LAPACK(lsame)(transA, "N");
|
||||
const int tranA = LAPACK(lsame)(transA, "T");
|
||||
const int notransB = LAPACK(lsame)(transB, "N");
|
||||
const int tranB = LAPACK(lsame)(transB, "T");
|
||||
int info = 0;
|
||||
const blasint lower = LAPACK(lsame)(uplo, "L");
|
||||
const blasint upper = LAPACK(lsame)(uplo, "U");
|
||||
const blasint notransA = LAPACK(lsame)(transA, "N");
|
||||
const blasint tranA = LAPACK(lsame)(transA, "T");
|
||||
const blasint notransB = LAPACK(lsame)(transB, "N");
|
||||
const blasint tranB = LAPACK(lsame)(transB, "T");
|
||||
blasint info = 0;
|
||||
if (!lower && !upper)
|
||||
info = 1;
|
||||
else if (!tranA && !notransA)
|
||||
|
|
@ -56,7 +56,7 @@ void RELAPACK_sgemmt(
|
|||
else if (*ldC < MAX(1, *n))
|
||||
info = 13;
|
||||
if (info) {
|
||||
LAPACK(xerbla)("SGEMMT", &info);
|
||||
LAPACK(xerbla)("SGEMMT", &info, strlen("SGEMMT"));
|
||||
return;
|
||||
}
|
||||
|
||||
|
|
@ -74,10 +74,10 @@ void RELAPACK_sgemmt(
|
|||
/** sgemmt's recursive compute kernel */
|
||||
static void RELAPACK_sgemmt_rec(
|
||||
const char *uplo, const char *transA, const char *transB,
|
||||
const int *n, const int *k,
|
||||
const float *alpha, const float *A, const int *ldA,
|
||||
const float *B, const int *ldB,
|
||||
const float *beta, float *C, const int *ldC
|
||||
const blasint *n, const blasint *k,
|
||||
const float *alpha, const float *A, const blasint *ldA,
|
||||
const float *B, const blasint *ldB,
|
||||
const float *beta, float *C, const blasint *ldC
|
||||
) {
|
||||
|
||||
if (*n <= MAX(CROSSOVER_SGEMMT, 1)) {
|
||||
|
|
@ -87,8 +87,8 @@ static void RELAPACK_sgemmt_rec(
|
|||
}
|
||||
|
||||
// Splitting
|
||||
const int n1 = SREC_SPLIT(*n);
|
||||
const int n2 = *n - n1;
|
||||
const blasint n1 = SREC_SPLIT(*n);
|
||||
const blasint n2 = *n - n1;
|
||||
|
||||
// A_T
|
||||
// A_B
|
||||
|
|
@ -124,16 +124,16 @@ static void RELAPACK_sgemmt_rec(
|
|||
/** sgemmt's unblocked compute kernel */
|
||||
static void RELAPACK_sgemmt_rec2(
|
||||
const char *uplo, const char *transA, const char *transB,
|
||||
const int *n, const int *k,
|
||||
const float *alpha, const float *A, const int *ldA,
|
||||
const float *B, const int *ldB,
|
||||
const float *beta, float *C, const int *ldC
|
||||
const blasint *n, const blasint *k,
|
||||
const float *alpha, const float *A, const blasint *ldA,
|
||||
const float *B, const blasint *ldB,
|
||||
const float *beta, float *C, const blasint *ldC
|
||||
) {
|
||||
|
||||
const int incB = (*transB == 'N') ? 1 : *ldB;
|
||||
const int incC = 1;
|
||||
const blasint incB = (*transB == 'N') ? 1 : *ldB;
|
||||
const blasint incC = 1;
|
||||
|
||||
int i;
|
||||
blasint i;
|
||||
for (i = 0; i < *n; i++) {
|
||||
// A_0
|
||||
// A_i
|
||||
|
|
@ -149,13 +149,13 @@ static void RELAPACK_sgemmt_rec2(
|
|||
float *const C_ii = C + *ldC * i + i;
|
||||
|
||||
if (*uplo == 'L') {
|
||||
const int nmi = *n - i;
|
||||
const blasint nmi = *n - i;
|
||||
if (*transA == 'N')
|
||||
BLAS(sgemv)(transA, &nmi, k, alpha, A_i, ldA, B_i, &incB, beta, C_ii, &incC);
|
||||
else
|
||||
BLAS(sgemv)(transA, k, &nmi, alpha, A_i, ldA, B_i, &incB, beta, C_ii, &incC);
|
||||
} else {
|
||||
const int ip1 = i + 1;
|
||||
const blasint ip1 = i + 1;
|
||||
if (*transA == 'N')
|
||||
BLAS(sgemv)(transA, &ip1, k, alpha, A_0, ldA, B_i, &incB, beta, C_0i, &incC);
|
||||
else
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
#include "relapack.h"
|
||||
|
||||
static void RELAPACK_sgetrf_rec(const int *, const int *, float *, const int *,
|
||||
int *, int *);
|
||||
static void RELAPACK_sgetrf_rec(const blasint *, const blasint *, float *, const blasint *,
|
||||
blasint *, blasint *);
|
||||
|
||||
|
||||
/** SGETRF computes an LU factorization of a general M-by-N matrix A using partial pivoting with row interchanges.
|
||||
|
|
@ -11,9 +11,9 @@ static void RELAPACK_sgetrf_rec(const int *, const int *, float *, const int *,
|
|||
* http://www.netlib.org/lapack/explore-html/de/de2/sgetrf_8f.html
|
||||
* */
|
||||
void RELAPACK_sgetrf(
|
||||
const int *m, const int *n,
|
||||
float *A, const int *ldA, int *ipiv,
|
||||
int *info
|
||||
const blasint *m, const blasint *n,
|
||||
float *A, const blasint *ldA, blasint *ipiv,
|
||||
blasint *info
|
||||
) {
|
||||
|
||||
// Check arguments
|
||||
|
|
@ -25,12 +25,12 @@ void RELAPACK_sgetrf(
|
|||
else if (*ldA < MAX(1, *n))
|
||||
*info = -4;
|
||||
if (*info) {
|
||||
const int minfo = -*info;
|
||||
LAPACK(xerbla)("SGETRF", &minfo);
|
||||
const blasint minfo = -*info;
|
||||
LAPACK(xerbla)("SGETRF", &minfo, strlen("SGETRF"));
|
||||
return;
|
||||
}
|
||||
|
||||
const int sn = MIN(*m, *n);
|
||||
const blasint sn = MIN(*m, *n);
|
||||
|
||||
RELAPACK_sgetrf_rec(m, &sn, A, ldA, ipiv, info);
|
||||
|
||||
|
|
@ -38,10 +38,10 @@ void RELAPACK_sgetrf(
|
|||
if (*m < *n) {
|
||||
// Constants
|
||||
const float ONE[] = { 1. };
|
||||
const int iONE[] = { 1. };
|
||||
const blasint iONE[] = { 1. };
|
||||
|
||||
// Splitting
|
||||
const int rn = *n - *m;
|
||||
const blasint rn = *n - *m;
|
||||
|
||||
// A_L A_R
|
||||
const float *const A_L = A;
|
||||
|
|
@ -57,9 +57,9 @@ void RELAPACK_sgetrf(
|
|||
|
||||
/** sgetrf's recursive compute kernel */
|
||||
static void RELAPACK_sgetrf_rec(
|
||||
const int *m, const int *n,
|
||||
float *A, const int *ldA, int *ipiv,
|
||||
int *info
|
||||
const blasint *m, const blasint *n,
|
||||
float *A, const blasint *ldA, blasint *ipiv,
|
||||
blasint *info
|
||||
) {
|
||||
|
||||
if (*n <= MAX(CROSSOVER_SGETRF, 1)) {
|
||||
|
|
@ -71,12 +71,12 @@ static void RELAPACK_sgetrf_rec(
|
|||
// Constants
|
||||
const float ONE[] = { 1. };
|
||||
const float MONE[] = { -1. };
|
||||
const int iONE[] = { 1 };
|
||||
const blasint iONE[] = { 1 };
|
||||
|
||||
// Splitting
|
||||
const int n1 = SREC_SPLIT(*n);
|
||||
const int n2 = *n - n1;
|
||||
const int m2 = *m - n1;
|
||||
const blasint n1 = SREC_SPLIT(*n);
|
||||
const blasint n2 = *n - n1;
|
||||
const blasint m2 = *m - n1;
|
||||
|
||||
// A_L A_R
|
||||
float *const A_L = A;
|
||||
|
|
@ -91,8 +91,8 @@ static void RELAPACK_sgetrf_rec(
|
|||
|
||||
// ipiv_T
|
||||
// ipiv_B
|
||||
int *const ipiv_T = ipiv;
|
||||
int *const ipiv_B = ipiv + n1;
|
||||
blasint *const ipiv_T = ipiv;
|
||||
blasint *const ipiv_B = ipiv + n1;
|
||||
|
||||
// recursion(A_L, ipiv_T)
|
||||
RELAPACK_sgetrf_rec(m, &n1, A_L, ldA, ipiv_T, info);
|
||||
|
|
@ -111,7 +111,7 @@ static void RELAPACK_sgetrf_rec(
|
|||
// apply pivots to A_BL
|
||||
LAPACK(slaswp)(&n1, A_BL, ldA, iONE, &n2, ipiv_B, iONE);
|
||||
// shift pivots
|
||||
int i;
|
||||
blasint i;
|
||||
for (i = 0; i < n2; i++)
|
||||
ipiv_B[i] += n1;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
#include "relapack.h"
|
||||
|
||||
static void RELAPACK_slauum_rec(const char *, const int *, float *,
|
||||
const int *, int *);
|
||||
static void RELAPACK_slauum_rec(const char *, const blasint *, float *,
|
||||
const blasint *, blasint *);
|
||||
|
||||
|
||||
/** SLAUUM computes the product U * U**T or L**T * L, where the triangular factor U or L is stored in the upper or lower triangular part of the array A.
|
||||
|
|
@ -11,14 +11,14 @@ static void RELAPACK_slauum_rec(const char *, const int *, float *,
|
|||
* http://www.netlib.org/lapack/explore-html/dd/d5a/slauum_8f.html
|
||||
* */
|
||||
void RELAPACK_slauum(
|
||||
const char *uplo, const int *n,
|
||||
float *A, const int *ldA,
|
||||
int *info
|
||||
const char *uplo, const blasint *n,
|
||||
float *A, const blasint *ldA,
|
||||
blasint *info
|
||||
) {
|
||||
|
||||
// Check arguments
|
||||
const int lower = LAPACK(lsame)(uplo, "L");
|
||||
const int upper = LAPACK(lsame)(uplo, "U");
|
||||
const blasint lower = LAPACK(lsame)(uplo, "L");
|
||||
const blasint upper = LAPACK(lsame)(uplo, "U");
|
||||
*info = 0;
|
||||
if (!lower && !upper)
|
||||
*info = -1;
|
||||
|
|
@ -27,8 +27,8 @@ void RELAPACK_slauum(
|
|||
else if (*ldA < MAX(1, *n))
|
||||
*info = -4;
|
||||
if (*info) {
|
||||
const int minfo = -*info;
|
||||
LAPACK(xerbla)("SLAUUM", &minfo);
|
||||
const blasint minfo = -*info;
|
||||
LAPACK(xerbla)("SLAUUM", &minfo, strlen("SLAUUM"));
|
||||
return;
|
||||
}
|
||||
|
||||
|
|
@ -42,9 +42,9 @@ void RELAPACK_slauum(
|
|||
|
||||
/** slauum's recursive compute kernel */
|
||||
static void RELAPACK_slauum_rec(
|
||||
const char *uplo, const int *n,
|
||||
float *A, const int *ldA,
|
||||
int *info
|
||||
const char *uplo, const blasint *n,
|
||||
float *A, const blasint *ldA,
|
||||
blasint *info
|
||||
) {
|
||||
|
||||
if (*n <= MAX(CROSSOVER_SLAUUM, 1)) {
|
||||
|
|
@ -57,8 +57,8 @@ static void RELAPACK_slauum_rec(
|
|||
const float ONE[] = { 1. };
|
||||
|
||||
// Splitting
|
||||
const int n1 = SREC_SPLIT(*n);
|
||||
const int n2 = *n - n1;
|
||||
const blasint n1 = SREC_SPLIT(*n);
|
||||
const blasint n2 = *n - n1;
|
||||
|
||||
// A_TL A_TR
|
||||
// A_BL A_BR
|
||||
|
|
|
|||
|
|
@ -1,8 +1,8 @@
|
|||
#include "relapack.h"
|
||||
#include "stdlib.h"
|
||||
|
||||
static void RELAPACK_spbtrf_rec(const char *, const int *, const int *,
|
||||
float *, const int *, float *, const int *, int *);
|
||||
static void RELAPACK_spbtrf_rec(const char *, const blasint *, const blasint *,
|
||||
float *, const blasint *, float *, const blasint *, blasint *);
|
||||
|
||||
|
||||
/** SPBTRF computes the Cholesky factorization of a real symmetric positive definite band matrix A.
|
||||
|
|
@ -12,14 +12,14 @@ static void RELAPACK_spbtrf_rec(const char *, const int *, const int *,
|
|||
* http://www.netlib.org/lapack/explore-html/d1/d22/spbtrf_8f.html
|
||||
* */
|
||||
void RELAPACK_spbtrf(
|
||||
const char *uplo, const int *n, const int *kd,
|
||||
float *Ab, const int *ldAb,
|
||||
int *info
|
||||
const char *uplo, const blasint *n, const blasint *kd,
|
||||
float *Ab, const blasint *ldAb,
|
||||
blasint *info
|
||||
) {
|
||||
|
||||
// Check arguments
|
||||
const int lower = LAPACK(lsame)(uplo, "L");
|
||||
const int upper = LAPACK(lsame)(uplo, "U");
|
||||
const blasint lower = LAPACK(lsame)(uplo, "L");
|
||||
const blasint upper = LAPACK(lsame)(uplo, "U");
|
||||
*info = 0;
|
||||
if (!lower && !upper)
|
||||
*info = -1;
|
||||
|
|
@ -30,8 +30,8 @@ void RELAPACK_spbtrf(
|
|||
else if (*ldAb < *kd + 1)
|
||||
*info = -5;
|
||||
if (*info) {
|
||||
const int minfo = -*info;
|
||||
LAPACK(xerbla)("SPBTRF", &minfo);
|
||||
const blasint minfo = -*info;
|
||||
LAPACK(xerbla)("SPBTRF", &minfo, strlen("SPBTRF"));
|
||||
return;
|
||||
}
|
||||
|
||||
|
|
@ -42,9 +42,9 @@ void RELAPACK_spbtrf(
|
|||
const float ZERO[] = { 0. };
|
||||
|
||||
// Allocate work space
|
||||
const int n1 = SREC_SPLIT(*n);
|
||||
const int mWork = (*kd > n1) ? (lower ? *n - *kd : n1) : *kd;
|
||||
const int nWork = (*kd > n1) ? (lower ? n1 : *n - *kd) : *kd;
|
||||
const blasint n1 = SREC_SPLIT(*n);
|
||||
const blasint mWork = (*kd > n1) ? (lower ? *n - *kd : n1) : *kd;
|
||||
const blasint nWork = (*kd > n1) ? (lower ? n1 : *n - *kd) : *kd;
|
||||
float *Work = malloc(mWork * nWork * sizeof(float));
|
||||
LAPACK(slaset)(uplo, &mWork, &nWork, ZERO, ZERO, Work, &mWork);
|
||||
|
||||
|
|
@ -58,10 +58,10 @@ void RELAPACK_spbtrf(
|
|||
|
||||
/** spbtrf's recursive compute kernel */
|
||||
static void RELAPACK_spbtrf_rec(
|
||||
const char *uplo, const int *n, const int *kd,
|
||||
float *Ab, const int *ldAb,
|
||||
float *Work, const int *ldWork,
|
||||
int *info
|
||||
const char *uplo, const blasint *n, const blasint *kd,
|
||||
float *Ab, const blasint *ldAb,
|
||||
float *Work, const blasint *ldWork,
|
||||
blasint *info
|
||||
){
|
||||
|
||||
if (*n <= MAX(CROSSOVER_SPBTRF, 1)) {
|
||||
|
|
@ -75,12 +75,12 @@ static void RELAPACK_spbtrf_rec(
|
|||
const float MONE[] = { -1. };
|
||||
|
||||
// Unskew A
|
||||
const int ldA[] = { *ldAb - 1 };
|
||||
const blasint ldA[] = { *ldAb - 1 };
|
||||
float *const A = Ab + ((*uplo == 'L') ? 0 : *kd);
|
||||
|
||||
// Splitting
|
||||
const int n1 = MIN(SREC_SPLIT(*n), *kd);
|
||||
const int n2 = *n - n1;
|
||||
const blasint n1 = MIN(SREC_SPLIT(*n), *kd);
|
||||
const blasint n2 = *n - n1;
|
||||
|
||||
// * *
|
||||
// * Ab_BR
|
||||
|
|
@ -99,8 +99,8 @@ static void RELAPACK_spbtrf_rec(
|
|||
return;
|
||||
|
||||
// Banded splitting
|
||||
const int n21 = MIN(n2, *kd - n1);
|
||||
const int n22 = MIN(n2 - n21, *kd);
|
||||
const blasint n21 = MIN(n2, *kd - n1);
|
||||
const blasint n22 = MIN(n2 - n21, *kd);
|
||||
|
||||
// n1 n21 n22
|
||||
// n1 * A_TRl A_TRr
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
#include "relapack.h"
|
||||
|
||||
static void RELAPACK_spotrf_rec(const char *, const int *, float *,
|
||||
const int *, int *);
|
||||
static void RELAPACK_spotrf_rec(const char *, const blasint *, float *,
|
||||
const blasint *, blasint *);
|
||||
|
||||
|
||||
/** SPOTRF computes the Cholesky factorization of a real symmetric positive definite matrix A.
|
||||
|
|
@ -11,14 +11,14 @@ static void RELAPACK_spotrf_rec(const char *, const int *, float *,
|
|||
* http://www.netlib.org/lapack/explore-html/d0/da2/spotrf_8f.html
|
||||
* */
|
||||
void RELAPACK_spotrf(
|
||||
const char *uplo, const int *n,
|
||||
float *A, const int *ldA,
|
||||
int *info
|
||||
const char *uplo, const blasint *n,
|
||||
float *A, const blasint *ldA,
|
||||
blasint *info
|
||||
) {
|
||||
|
||||
// Check arguments
|
||||
const int lower = LAPACK(lsame)(uplo, "L");
|
||||
const int upper = LAPACK(lsame)(uplo, "U");
|
||||
const blasint lower = LAPACK(lsame)(uplo, "L");
|
||||
const blasint upper = LAPACK(lsame)(uplo, "U");
|
||||
*info = 0;
|
||||
if (!lower && !upper)
|
||||
*info = -1;
|
||||
|
|
@ -27,8 +27,8 @@ void RELAPACK_spotrf(
|
|||
else if (*ldA < MAX(1, *n))
|
||||
*info = -4;
|
||||
if (*info) {
|
||||
const int minfo = -*info;
|
||||
LAPACK(xerbla)("SPOTRF", &minfo);
|
||||
const blasint minfo = -*info;
|
||||
LAPACK(xerbla)("SPOTRF", &minfo, strlen("SPOTRF"));
|
||||
return;
|
||||
}
|
||||
|
||||
|
|
@ -42,9 +42,9 @@ void RELAPACK_spotrf(
|
|||
|
||||
/** spotrf's recursive compute kernel */
|
||||
static void RELAPACK_spotrf_rec(
|
||||
const char *uplo, const int *n,
|
||||
float *A, const int *ldA,
|
||||
int *info
|
||||
const char *uplo, const blasint *n,
|
||||
float *A, const blasint *ldA,
|
||||
blasint *info
|
||||
) {
|
||||
|
||||
if (*n <= MAX(CROSSOVER_SPOTRF, 1)) {
|
||||
|
|
@ -58,8 +58,8 @@ static void RELAPACK_spotrf_rec(
|
|||
const float MONE[] = { -1. };
|
||||
|
||||
// Splitting
|
||||
const int n1 = SREC_SPLIT(*n);
|
||||
const int n2 = *n - n1;
|
||||
const blasint n1 = SREC_SPLIT(*n);
|
||||
const blasint n2 = *n - n1;
|
||||
|
||||
// A_TL A_TR
|
||||
// A_BL A_BR
|
||||
|
|
|
|||
|
|
@ -3,9 +3,9 @@
|
|||
#include "stdlib.h"
|
||||
#endif
|
||||
|
||||
static void RELAPACK_ssygst_rec(const int *, const char *, const int *,
|
||||
float *, const int *, const float *, const int *,
|
||||
float *, const int *, int *);
|
||||
static void RELAPACK_ssygst_rec(const blasint *, const char *, const blasint *,
|
||||
float *, const blasint *, const float *, const blasint *,
|
||||
float *, const blasint *, blasint *);
|
||||
|
||||
|
||||
/** SSYGST reduces a real symmetric-definite generalized eigenproblem to standard form.
|
||||
|
|
@ -15,14 +15,14 @@ static void RELAPACK_ssygst_rec(const int *, const char *, const int *,
|
|||
* http://www.netlib.org/lapack/explore-html/d8/d78/ssygst_8f.html
|
||||
* */
|
||||
void RELAPACK_ssygst(
|
||||
const int *itype, const char *uplo, const int *n,
|
||||
float *A, const int *ldA, const float *B, const int *ldB,
|
||||
int *info
|
||||
const blasint *itype, const char *uplo, const blasint *n,
|
||||
float *A, const blasint *ldA, const float *B, const blasint *ldB,
|
||||
blasint *info
|
||||
) {
|
||||
|
||||
// Check arguments
|
||||
const int lower = LAPACK(lsame)(uplo, "L");
|
||||
const int upper = LAPACK(lsame)(uplo, "U");
|
||||
const blasint lower = LAPACK(lsame)(uplo, "L");
|
||||
const blasint upper = LAPACK(lsame)(uplo, "U");
|
||||
*info = 0;
|
||||
if (*itype < 1 || *itype > 3)
|
||||
*info = -1;
|
||||
|
|
@ -35,8 +35,8 @@ void RELAPACK_ssygst(
|
|||
else if (*ldB < MAX(1, *n))
|
||||
*info = -7;
|
||||
if (*info) {
|
||||
const int minfo = -*info;
|
||||
LAPACK(xerbla)("SSYGST", &minfo);
|
||||
const blasint minfo = -*info;
|
||||
LAPACK(xerbla)("SSYGST", &minfo, strlen("SSYGST"));
|
||||
return;
|
||||
}
|
||||
|
||||
|
|
@ -45,9 +45,9 @@ void RELAPACK_ssygst(
|
|||
|
||||
// Allocate work space
|
||||
float *Work = NULL;
|
||||
int lWork = 0;
|
||||
blasint lWork = 0;
|
||||
#if XSYGST_ALLOW_MALLOC
|
||||
const int n1 = SREC_SPLIT(*n);
|
||||
const blasint n1 = SREC_SPLIT(*n);
|
||||
lWork = n1 * (*n - n1);
|
||||
Work = malloc(lWork * sizeof(float));
|
||||
if (!Work)
|
||||
|
|
@ -67,9 +67,9 @@ void RELAPACK_ssygst(
|
|||
|
||||
/** ssygst's recursive compute kernel */
|
||||
static void RELAPACK_ssygst_rec(
|
||||
const int *itype, const char *uplo, const int *n,
|
||||
float *A, const int *ldA, const float *B, const int *ldB,
|
||||
float *Work, const int *lWork, int *info
|
||||
const blasint *itype, const char *uplo, const blasint *n,
|
||||
float *A, const blasint *ldA, const float *B, const blasint *ldB,
|
||||
float *Work, const blasint *lWork, blasint *info
|
||||
) {
|
||||
|
||||
if (*n <= MAX(CROSSOVER_SSYGST, 1)) {
|
||||
|
|
@ -84,14 +84,14 @@ static void RELAPACK_ssygst_rec(
|
|||
const float MONE[] = { -1. };
|
||||
const float HALF[] = { .5 };
|
||||
const float MHALF[] = { -.5 };
|
||||
const int iONE[] = { 1 };
|
||||
const blasint iONE[] = { 1 };
|
||||
|
||||
// Loop iterator
|
||||
int i;
|
||||
blasint i;
|
||||
|
||||
// Splitting
|
||||
const int n1 = SREC_SPLIT(*n);
|
||||
const int n2 = *n - n1;
|
||||
const blasint n1 = SREC_SPLIT(*n);
|
||||
const blasint n2 = *n - n1;
|
||||
|
||||
// A_TL A_TR
|
||||
// A_BL A_BR
|
||||
|
|
|
|||
|
|
@ -2,9 +2,8 @@
|
|||
#if XSYTRF_ALLOW_MALLOC
|
||||
#include <stdlib.h>
|
||||
#endif
|
||||
|
||||
static void RELAPACK_ssytrf_rec(const char *, const int *, const int *, int *,
|
||||
float *, const int *, int *, float *, const int *, int *);
|
||||
static void RELAPACK_ssytrf_rec(const char *, const blasint *, const blasint *, blasint *,
|
||||
float *, const blasint *, blasint *, float *, const blasint *, blasint *);
|
||||
|
||||
|
||||
/** SSYTRF computes the factorization of a complex symmetric matrix A using the Bunch-Kaufman diagonal pivoting method.
|
||||
|
|
@ -14,21 +13,21 @@ static void RELAPACK_ssytrf_rec(const char *, const int *, const int *, int *,
|
|||
* http://www.netlib.org/lapack/explore-html/da/de9/ssytrf_8f.html
|
||||
* */
|
||||
void RELAPACK_ssytrf(
|
||||
const char *uplo, const int *n,
|
||||
float *A, const int *ldA, int *ipiv,
|
||||
float *Work, const int *lWork, int *info
|
||||
const char *uplo, const blasint *n,
|
||||
float *A, const blasint *ldA, blasint *ipiv,
|
||||
float *Work, const blasint *lWork, blasint *info
|
||||
) {
|
||||
|
||||
// Required work size
|
||||
const int cleanlWork = *n * (*n / 2);
|
||||
int minlWork = cleanlWork;
|
||||
const blasint cleanlWork = *n * (*n / 2);
|
||||
blasint minlWork = cleanlWork;
|
||||
#if XSYTRF_ALLOW_MALLOC
|
||||
minlWork = 1;
|
||||
#endif
|
||||
|
||||
// Check arguments
|
||||
const int lower = LAPACK(lsame)(uplo, "L");
|
||||
const int upper = LAPACK(lsame)(uplo, "U");
|
||||
const blasint lower = LAPACK(lsame)(uplo, "L");
|
||||
const blasint upper = LAPACK(lsame)(uplo, "U");
|
||||
*info = 0;
|
||||
if (!lower && !upper)
|
||||
*info = -1;
|
||||
|
|
@ -55,8 +54,8 @@ void RELAPACK_ssytrf(
|
|||
#endif
|
||||
|
||||
if (*info) {
|
||||
const int minfo = -*info;
|
||||
LAPACK(xerbla)("SSYTRF", &minfo);
|
||||
const blasint minfo = -*info;
|
||||
LAPACK(xerbla)("SSYTRF", &minfo, strlen("SSYTRF"));
|
||||
return;
|
||||
}
|
||||
|
||||
|
|
@ -64,7 +63,7 @@ void RELAPACK_ssytrf(
|
|||
const char cleanuplo = lower ? 'L' : 'U';
|
||||
|
||||
// Dummy arguments
|
||||
int nout;
|
||||
blasint nout;
|
||||
|
||||
// Recursive kernel
|
||||
RELAPACK_ssytrf_rec(&cleanuplo, n, n, &nout, A, ldA, ipiv, cleanWork, n, info);
|
||||
|
|
@ -78,13 +77,13 @@ void RELAPACK_ssytrf(
|
|||
|
||||
/** ssytrf's recursive compute kernel */
|
||||
static void RELAPACK_ssytrf_rec(
|
||||
const char *uplo, const int *n_full, const int *n, int *n_out,
|
||||
float *A, const int *ldA, int *ipiv,
|
||||
float *Work, const int *ldWork, int *info
|
||||
const char *uplo, const blasint *n_full, const blasint *n, blasint *n_out,
|
||||
float *A, const blasint *ldA, blasint *ipiv,
|
||||
float *Work, const blasint *ldWork, blasint *info
|
||||
) {
|
||||
|
||||
// top recursion level?
|
||||
const int top = *n_full == *n;
|
||||
const blasint top = *n_full == *n;
|
||||
|
||||
if (*n <= MAX(CROSSOVER_SSYTRF, 3)) {
|
||||
// Unblocked
|
||||
|
|
@ -96,34 +95,34 @@ static void RELAPACK_ssytrf_rec(
|
|||
return;
|
||||
}
|
||||
|
||||
int info1, info2;
|
||||
blasint info1, info2;
|
||||
|
||||
// Constants
|
||||
const float ONE[] = { 1. };
|
||||
const float MONE[] = { -1. };
|
||||
const int iONE[] = { 1 };
|
||||
const blasint iONE[] = { 1 };
|
||||
|
||||
// Loop iterator
|
||||
int i;
|
||||
blasint i;
|
||||
|
||||
const int n_rest = *n_full - *n;
|
||||
const blasint n_rest = *n_full - *n;
|
||||
|
||||
if (*uplo == 'L') {
|
||||
// Splitting (setup)
|
||||
int n1 = SREC_SPLIT(*n);
|
||||
int n2 = *n - n1;
|
||||
blasint n1 = SREC_SPLIT(*n);
|
||||
blasint n2 = *n - n1;
|
||||
|
||||
// Work_L *
|
||||
float *const Work_L = Work;
|
||||
|
||||
// recursion(A_L)
|
||||
int n1_out;
|
||||
blasint n1_out;
|
||||
RELAPACK_ssytrf_rec(uplo, n_full, &n1, &n1_out, A, ldA, ipiv, Work_L, ldWork, &info1);
|
||||
n1 = n1_out;
|
||||
|
||||
// Splitting (continued)
|
||||
n2 = *n - n1;
|
||||
const int n_full2 = *n_full - n1;
|
||||
const blasint n_full2 = *n_full - n1;
|
||||
|
||||
// * *
|
||||
// A_BL A_BR
|
||||
|
|
@ -139,23 +138,23 @@ static void RELAPACK_ssytrf_rec(
|
|||
// (top recursion level: use Work as Work_BR)
|
||||
float *const Work_BL = Work + n1;
|
||||
float *const Work_BR = top ? Work : Work + *ldWork * n1 + n1;
|
||||
const int ldWork_BR = top ? n2 : *ldWork;
|
||||
const blasint ldWork_BR = top ? n2 : *ldWork;
|
||||
|
||||
// ipiv_T
|
||||
// ipiv_B
|
||||
int *const ipiv_B = ipiv + n1;
|
||||
blasint *const ipiv_B = ipiv + n1;
|
||||
|
||||
// A_BR = A_BR - A_BL Work_BL'
|
||||
RELAPACK_sgemmt(uplo, "N", "T", &n2, &n1, MONE, A_BL, ldA, Work_BL, ldWork, ONE, A_BR, ldA);
|
||||
BLAS(sgemm)("N", "T", &n_rest, &n2, &n1, MONE, A_BL_B, ldA, Work_BL, ldWork, ONE, A_BR_B, ldA);
|
||||
|
||||
// recursion(A_BR)
|
||||
int n2_out;
|
||||
blasint n2_out;
|
||||
RELAPACK_ssytrf_rec(uplo, &n_full2, &n2, &n2_out, A_BR, ldA, ipiv_B, Work_BR, &ldWork_BR, &info2);
|
||||
|
||||
if (n2_out != n2) {
|
||||
// undo 1 column of updates
|
||||
const int n_restp1 = n_rest + 1;
|
||||
const blasint n_restp1 = n_rest + 1;
|
||||
|
||||
// last column of A_BR
|
||||
float *const A_BR_r = A_BR + *ldA * n2_out + n2_out;
|
||||
|
|
@ -182,22 +181,22 @@ static void RELAPACK_ssytrf_rec(
|
|||
*n_out = n1 + n2;
|
||||
} else {
|
||||
// Splitting (setup)
|
||||
int n2 = SREC_SPLIT(*n);
|
||||
int n1 = *n - n2;
|
||||
blasint n2 = SREC_SPLIT(*n);
|
||||
blasint n1 = *n - n2;
|
||||
|
||||
// * Work_R
|
||||
// (top recursion level: use Work as Work_R)
|
||||
float *const Work_R = top ? Work : Work + *ldWork * n1;
|
||||
|
||||
// recursion(A_R)
|
||||
int n2_out;
|
||||
blasint n2_out;
|
||||
RELAPACK_ssytrf_rec(uplo, n_full, &n2, &n2_out, A, ldA, ipiv, Work_R, ldWork, &info2);
|
||||
const int n2_diff = n2 - n2_out;
|
||||
const blasint n2_diff = n2 - n2_out;
|
||||
n2 = n2_out;
|
||||
|
||||
// Splitting (continued)
|
||||
n1 = *n - n2;
|
||||
const int n_full1 = *n_full - n2;
|
||||
const blasint n_full1 = *n_full - n2;
|
||||
|
||||
// * A_TL_T A_TR_T
|
||||
// * A_TL A_TR
|
||||
|
|
@ -213,19 +212,19 @@ static void RELAPACK_ssytrf_rec(
|
|||
// (top recursion level: Work_R was Work)
|
||||
float *const Work_L = Work;
|
||||
float *const Work_TR = Work + *ldWork * (top ? n2_diff : n1) + n_rest;
|
||||
const int ldWork_L = top ? n1 : *ldWork;
|
||||
const blasint ldWork_L = top ? n1 : *ldWork;
|
||||
|
||||
// A_TL = A_TL - A_TR Work_TR'
|
||||
RELAPACK_sgemmt(uplo, "N", "T", &n1, &n2, MONE, A_TR, ldA, Work_TR, ldWork, ONE, A_TL, ldA);
|
||||
BLAS(sgemm)("N", "T", &n_rest, &n1, &n2, MONE, A_TR_T, ldA, Work_TR, ldWork, ONE, A_TL_T, ldA);
|
||||
|
||||
// recursion(A_TL)
|
||||
int n1_out;
|
||||
blasint n1_out;
|
||||
RELAPACK_ssytrf_rec(uplo, &n_full1, &n1, &n1_out, A, ldA, ipiv, Work_L, &ldWork_L, &info1);
|
||||
|
||||
if (n1_out != n1) {
|
||||
// undo 1 column of updates
|
||||
const int n_restp1 = n_rest + 1;
|
||||
const blasint n_restp1 = n_rest + 1;
|
||||
|
||||
// A_TL_T_l = A_TL_T_l + A_TR_T Work_TR_t'
|
||||
BLAS(sgemv)("N", &n_restp1, &n2, ONE, A_TR_T, ldA, Work_TR, ldWork, ONE, A_TL_T, iONE);
|
||||
|
|
|
|||
|
|
@ -14,7 +14,7 @@
|
|||
|
||||
/* Table of constant values */
|
||||
|
||||
static int c__1 = 1;
|
||||
static blasint c__1 = 1;
|
||||
static float c_b8 = -1.f;
|
||||
static float c_b9 = 1.f;
|
||||
|
||||
|
|
@ -25,32 +25,32 @@ static float c_b9 = 1.f;
|
|||
* The blocked BLAS Level 3 updates were removed and moved to the
|
||||
* recursive algorithm.
|
||||
* */
|
||||
/* Subroutine */ void RELAPACK_ssytrf_rec2(char *uplo, int *n, int *
|
||||
nb, int *kb, float *a, int *lda, int *ipiv, float *w,
|
||||
int *ldw, int *info, ftnlen uplo_len)
|
||||
/* Subroutine */ void RELAPACK_ssytrf_rec2(char *uplo, blasint *n, blasint *
|
||||
nb, blasint *kb, float *a, blasint *lda, blasint *ipiv, float *w,
|
||||
int *ldw, blasint *info, ftnlen uplo_len)
|
||||
{
|
||||
/* System generated locals */
|
||||
int a_dim1, a_offset, w_dim1, w_offset, i__1, i__2;
|
||||
blasint a_dim1, a_offset, w_dim1, w_offset, i__1, i__2;
|
||||
float r__1, r__2, r__3;
|
||||
|
||||
/* Builtin functions */
|
||||
double sqrt(double);
|
||||
|
||||
/* Local variables */
|
||||
static int j, k;
|
||||
static blasint j, k;
|
||||
static float t, r1, d11, d21, d22;
|
||||
static int jj, kk, jp, kp, kw, kkw, imax, jmax;
|
||||
static blasint jj, kk, jp, kp, kw, kkw, imax, jmax;
|
||||
static float alpha;
|
||||
extern logical lsame_(char *, char *, ftnlen, ftnlen);
|
||||
extern /* Subroutine */ int sscal_(int *, float *, float *, int *),
|
||||
sgemv_(char *, int *, int *, float *, float *, int *,
|
||||
float *, int *, float *, float *, int *, ftnlen);
|
||||
static int kstep;
|
||||
extern /* Subroutine */ int scopy_(int *, float *, int *, float *,
|
||||
int *), sswap_(int *, float *, int *, float *, int *
|
||||
extern /* Subroutine */ blasint sscal_(int *, float *, float *, blasint *),
|
||||
sgemv_(char *, blasint *, blasint *, float *, float *, blasint *,
|
||||
float *, blasint *, float *, float *, blasint *, ftnlen);
|
||||
static blasint kstep;
|
||||
extern /* Subroutine */ blasint scopy_(int *, float *, blasint *, float *,
|
||||
blasint *), sswap_(int *, float *, blasint *, float *, blasint *
|
||||
);
|
||||
static float absakk;
|
||||
extern int isamax_(int *, float *, int *);
|
||||
extern blasint isamax_(int *, float *, blasint *);
|
||||
static float colmax, rowmax;
|
||||
|
||||
/* Parameter adjustments */
|
||||
|
|
|
|||
|
|
@ -3,8 +3,8 @@
|
|||
#include <stdlib.h>
|
||||
#endif
|
||||
|
||||
static void RELAPACK_ssytrf_rook_rec(const char *, const int *, const int *, int *,
|
||||
float *, const int *, int *, float *, const int *, int *);
|
||||
static void RELAPACK_ssytrf_rook_rec(const char *, const blasint *, const blasint *, blasint *,
|
||||
float *, const blasint *, blasint *, float *, const blasint *, blasint *);
|
||||
|
||||
|
||||
/** SSYTRF_ROOK computes the factorization of a real symmetric matrix A using the bounded Bunch-Kaufman ("rook") diagonal pivoting method.
|
||||
|
|
@ -14,21 +14,21 @@ static void RELAPACK_ssytrf_rook_rec(const char *, const int *, const int *, int
|
|||
* http://www.netlib.org/lapack/explore-html/de/da4/ssytrf__rook_8f.html
|
||||
* */
|
||||
void RELAPACK_ssytrf_rook(
|
||||
const char *uplo, const int *n,
|
||||
float *A, const int *ldA, int *ipiv,
|
||||
float *Work, const int *lWork, int *info
|
||||
const char *uplo, const blasint *n,
|
||||
float *A, const blasint *ldA, blasint *ipiv,
|
||||
float *Work, const blasint *lWork, blasint *info
|
||||
) {
|
||||
|
||||
// Required work size
|
||||
const int cleanlWork = *n * (*n / 2);
|
||||
int minlWork = cleanlWork;
|
||||
const blasint cleanlWork = *n * (*n / 2);
|
||||
blasint minlWork = cleanlWork;
|
||||
#if XSYTRF_ALLOW_MALLOC
|
||||
minlWork = 1;
|
||||
#endif
|
||||
|
||||
// Check arguments
|
||||
const int lower = LAPACK(lsame)(uplo, "L");
|
||||
const int upper = LAPACK(lsame)(uplo, "U");
|
||||
const blasint lower = LAPACK(lsame)(uplo, "L");
|
||||
const blasint upper = LAPACK(lsame)(uplo, "U");
|
||||
*info = 0;
|
||||
if (!lower && !upper)
|
||||
*info = -1;
|
||||
|
|
@ -55,8 +55,8 @@ void RELAPACK_ssytrf_rook(
|
|||
#endif
|
||||
|
||||
if (*info) {
|
||||
const int minfo = -*info;
|
||||
LAPACK(xerbla)("SSYTRF", &minfo);
|
||||
const blasint minfo = -*info;
|
||||
LAPACK(xerbla)("SSYTRF", &minfo, strlen("SSYTRF"));
|
||||
return;
|
||||
}
|
||||
|
||||
|
|
@ -64,7 +64,7 @@ void RELAPACK_ssytrf_rook(
|
|||
const char cleanuplo = lower ? 'L' : 'U';
|
||||
|
||||
// Dummy argument
|
||||
int nout;
|
||||
blasint nout;
|
||||
|
||||
// Recursive kernel
|
||||
RELAPACK_ssytrf_rook_rec(&cleanuplo, n, n, &nout, A, ldA, ipiv, cleanWork, n, info);
|
||||
|
|
@ -78,13 +78,13 @@ void RELAPACK_ssytrf_rook(
|
|||
|
||||
/** ssytrf_rook's recursive compute kernel */
|
||||
static void RELAPACK_ssytrf_rook_rec(
|
||||
const char *uplo, const int *n_full, const int *n, int *n_out,
|
||||
float *A, const int *ldA, int *ipiv,
|
||||
float *Work, const int *ldWork, int *info
|
||||
const char *uplo, const blasint *n_full, const blasint *n, blasint *n_out,
|
||||
float *A, const blasint *ldA, blasint *ipiv,
|
||||
float *Work, const blasint *ldWork, blasint *info
|
||||
) {
|
||||
|
||||
// top recursion level?
|
||||
const int top = *n_full == *n;
|
||||
const blasint top = *n_full == *n;
|
||||
|
||||
if (*n <= MAX(CROSSOVER_SSYTRF_ROOK, 3)) {
|
||||
// Unblocked
|
||||
|
|
@ -96,31 +96,31 @@ static void RELAPACK_ssytrf_rook_rec(
|
|||
return;
|
||||
}
|
||||
|
||||
int info1, info2;
|
||||
blasint info1, info2;
|
||||
|
||||
// Constants
|
||||
const float ONE[] = { 1. };
|
||||
const float MONE[] = { -1. };
|
||||
const int iONE[] = { 1 };
|
||||
const blasint iONE[] = { 1 };
|
||||
|
||||
const int n_rest = *n_full - *n;
|
||||
const blasint n_rest = *n_full - *n;
|
||||
|
||||
if (*uplo == 'L') {
|
||||
// Splitting (setup)
|
||||
int n1 = SREC_SPLIT(*n);
|
||||
int n2 = *n - n1;
|
||||
blasint n1 = SREC_SPLIT(*n);
|
||||
blasint n2 = *n - n1;
|
||||
|
||||
// Work_L *
|
||||
float *const Work_L = Work;
|
||||
|
||||
// recursion(A_L)
|
||||
int n1_out;
|
||||
blasint n1_out;
|
||||
RELAPACK_ssytrf_rook_rec(uplo, n_full, &n1, &n1_out, A, ldA, ipiv, Work_L, ldWork, &info1);
|
||||
n1 = n1_out;
|
||||
|
||||
// Splitting (continued)
|
||||
n2 = *n - n1;
|
||||
const int n_full2 = *n_full - n1;
|
||||
const blasint n_full2 = *n_full - n1;
|
||||
|
||||
// * *
|
||||
// A_BL A_BR
|
||||
|
|
@ -136,23 +136,23 @@ static void RELAPACK_ssytrf_rook_rec(
|
|||
// (top recursion level: use Work as Work_BR)
|
||||
float *const Work_BL = Work + n1;
|
||||
float *const Work_BR = top ? Work : Work + *ldWork * n1 + n1;
|
||||
const int ldWork_BR = top ? n2 : *ldWork;
|
||||
const blasint ldWork_BR = top ? n2 : *ldWork;
|
||||
|
||||
// ipiv_T
|
||||
// ipiv_B
|
||||
int *const ipiv_B = ipiv + n1;
|
||||
blasint *const ipiv_B = ipiv + n1;
|
||||
|
||||
// A_BR = A_BR - A_BL Work_BL'
|
||||
RELAPACK_sgemmt(uplo, "N", "T", &n2, &n1, MONE, A_BL, ldA, Work_BL, ldWork, ONE, A_BR, ldA);
|
||||
BLAS(sgemm)("N", "T", &n_rest, &n2, &n1, MONE, A_BL_B, ldA, Work_BL, ldWork, ONE, A_BR_B, ldA);
|
||||
|
||||
// recursion(A_BR)
|
||||
int n2_out;
|
||||
blasint n2_out;
|
||||
RELAPACK_ssytrf_rook_rec(uplo, &n_full2, &n2, &n2_out, A_BR, ldA, ipiv_B, Work_BR, &ldWork_BR, &info2);
|
||||
|
||||
if (n2_out != n2) {
|
||||
// undo 1 column of updates
|
||||
const int n_restp1 = n_rest + 1;
|
||||
const blasint n_restp1 = n_rest + 1;
|
||||
|
||||
// last column of A_BR
|
||||
float *const A_BR_r = A_BR + *ldA * n2_out + n2_out;
|
||||
|
|
@ -169,7 +169,7 @@ static void RELAPACK_ssytrf_rook_rec(
|
|||
n2 = n2_out;
|
||||
|
||||
// shift pivots
|
||||
int i;
|
||||
blasint i;
|
||||
for (i = 0; i < n2; i++)
|
||||
if (ipiv_B[i] > 0)
|
||||
ipiv_B[i] += n1;
|
||||
|
|
@ -180,22 +180,22 @@ static void RELAPACK_ssytrf_rook_rec(
|
|||
*n_out = n1 + n2;
|
||||
} else {
|
||||
// Splitting (setup)
|
||||
int n2 = SREC_SPLIT(*n);
|
||||
int n1 = *n - n2;
|
||||
blasint n2 = SREC_SPLIT(*n);
|
||||
blasint n1 = *n - n2;
|
||||
|
||||
// * Work_R
|
||||
// (top recursion level: use Work as Work_R)
|
||||
float *const Work_R = top ? Work : Work + *ldWork * n1;
|
||||
|
||||
// recursion(A_R)
|
||||
int n2_out;
|
||||
blasint n2_out;
|
||||
RELAPACK_ssytrf_rook_rec(uplo, n_full, &n2, &n2_out, A, ldA, ipiv, Work_R, ldWork, &info2);
|
||||
const int n2_diff = n2 - n2_out;
|
||||
const blasint n2_diff = n2 - n2_out;
|
||||
n2 = n2_out;
|
||||
|
||||
// Splitting (continued)
|
||||
n1 = *n - n2;
|
||||
const int n_full1 = *n_full - n2;
|
||||
const blasint n_full1 = *n_full - n2;
|
||||
|
||||
// * A_TL_T A_TR_T
|
||||
// * A_TL A_TR
|
||||
|
|
@ -211,19 +211,19 @@ static void RELAPACK_ssytrf_rook_rec(
|
|||
// (top recursion level: Work_R was Work)
|
||||
float *const Work_L = Work;
|
||||
float *const Work_TR = Work + *ldWork * (top ? n2_diff : n1) + n_rest;
|
||||
const int ldWork_L = top ? n1 : *ldWork;
|
||||
const blasint ldWork_L = top ? n1 : *ldWork;
|
||||
|
||||
// A_TL = A_TL - A_TR Work_TR'
|
||||
RELAPACK_sgemmt(uplo, "N", "T", &n1, &n2, MONE, A_TR, ldA, Work_TR, ldWork, ONE, A_TL, ldA);
|
||||
BLAS(sgemm)("N", "T", &n_rest, &n1, &n2, MONE, A_TR_T, ldA, Work_TR, ldWork, ONE, A_TL_T, ldA);
|
||||
|
||||
// recursion(A_TL)
|
||||
int n1_out;
|
||||
blasint n1_out;
|
||||
RELAPACK_ssytrf_rook_rec(uplo, &n_full1, &n1, &n1_out, A, ldA, ipiv, Work_L, &ldWork_L, &info1);
|
||||
|
||||
if (n1_out != n1) {
|
||||
// undo 1 column of updates
|
||||
const int n_restp1 = n_rest + 1;
|
||||
const blasint n_restp1 = n_rest + 1;
|
||||
|
||||
// A_TL_T_l = A_TL_T_l + A_TR_T Work_TR_t'
|
||||
BLAS(sgemv)("N", &n_restp1, &n2, ONE, A_TR_T, ldA, Work_TR, ldWork, ONE, A_TL_T, iONE);
|
||||
|
|
|
|||
|
|
@ -14,7 +14,7 @@
|
|||
|
||||
/* Table of constant values */
|
||||
|
||||
static int c__1 = 1;
|
||||
static blasint c__1 = 1;
|
||||
static float c_b9 = -1.f;
|
||||
static float c_b10 = 1.f;
|
||||
|
||||
|
|
@ -25,39 +25,39 @@ static float c_b10 = 1.f;
|
|||
* The blocked BLAS Level 3 updates were removed and moved to the
|
||||
* recursive algorithm.
|
||||
* */
|
||||
/* Subroutine */ void RELAPACK_ssytrf_rook_rec2(char *uplo, int *n,
|
||||
int *nb, int *kb, float *a, int *lda, int *ipiv, float *
|
||||
w, int *ldw, int *info, ftnlen uplo_len)
|
||||
/* Subroutine */ void RELAPACK_ssytrf_rook_rec2(char *uplo, blasint *n,
|
||||
int *nb, blasint *kb, float *a, blasint *lda, blasint *ipiv, float *
|
||||
w, blasint *ldw, blasint *info, ftnlen uplo_len)
|
||||
{
|
||||
/* System generated locals */
|
||||
int a_dim1, a_offset, w_dim1, w_offset, i__1, i__2;
|
||||
blasint a_dim1, a_offset, w_dim1, w_offset, i__1, i__2;
|
||||
float r__1;
|
||||
|
||||
/* Builtin functions */
|
||||
double sqrt(double);
|
||||
|
||||
/* Local variables */
|
||||
static int j, k, p;
|
||||
static blasint j, k, p;
|
||||
static float t, r1, d11, d12, d21, d22;
|
||||
static int ii, jj, kk, kp, kw, jp1, jp2, kkw;
|
||||
static blasint ii, jj, kk, kp, kw, jp1, jp2, kkw;
|
||||
static logical done;
|
||||
static int imax, jmax;
|
||||
static blasint imax, jmax;
|
||||
static float alpha;
|
||||
extern logical lsame_(char *, char *, ftnlen, ftnlen);
|
||||
extern /* Subroutine */ int sscal_(int *, float *, float *, int *);
|
||||
extern /* Subroutine */ blasint sscal_(int *, float *, float *, blasint *);
|
||||
static float sfmin;
|
||||
static int itemp;
|
||||
extern /* Subroutine */ int sgemv_(char *, int *, int *, float *,
|
||||
float *, int *, float *, int *, float *, float *, int *,
|
||||
static blasint itemp;
|
||||
extern /* Subroutine */ blasint sgemv_(char *, blasint *, blasint *, float *,
|
||||
float *, blasint *, float *, blasint *, float *, float *, blasint *,
|
||||
ftnlen);
|
||||
static int kstep;
|
||||
static blasint kstep;
|
||||
static float stemp;
|
||||
extern /* Subroutine */ int scopy_(int *, float *, int *, float *,
|
||||
int *), sswap_(int *, float *, int *, float *, int *
|
||||
extern /* Subroutine */ blasint scopy_(int *, float *, blasint *, float *,
|
||||
blasint *), sswap_(int *, float *, blasint *, float *, blasint *
|
||||
);
|
||||
static float absakk;
|
||||
extern double slamch_(char *, ftnlen);
|
||||
extern int isamax_(int *, float *, int *);
|
||||
extern blasint isamax_(int *, float *, blasint *);
|
||||
static float colmax, rowmax;
|
||||
|
||||
/* Parameter adjustments */
|
||||
|
|
|
|||
|
|
@ -1,11 +1,11 @@
|
|||
#include "relapack.h"
|
||||
#include <math.h>
|
||||
|
||||
static void RELAPACK_stgsyl_rec(const char *, const int *, const int *,
|
||||
const int *, const float *, const int *, const float *, const int *,
|
||||
float *, const int *, const float *, const int *, const float *,
|
||||
const int *, float *, const int *, float *, float *, float *, int *, int *,
|
||||
int *);
|
||||
static void RELAPACK_stgsyl_rec(const char *, const blasint *, const blasint *,
|
||||
const blasint *, const float *, const blasint *, const float *, const blasint *,
|
||||
float *, const blasint *, const float *, const blasint *, const float *,
|
||||
const blasint *, float *, const blasint *, float *, float *, float *, blasint *, blasint *,
|
||||
blasint *);
|
||||
|
||||
|
||||
/** STGSYL solves the generalized Sylvester equation.
|
||||
|
|
@ -15,21 +15,21 @@ static void RELAPACK_stgsyl_rec(const char *, const int *, const int *,
|
|||
* http://www.netlib.org/lapack/explore-html/dc/d67/stgsyl_8f.html
|
||||
* */
|
||||
void RELAPACK_stgsyl(
|
||||
const char *trans, const int *ijob, const int *m, const int *n,
|
||||
const float *A, const int *ldA, const float *B, const int *ldB,
|
||||
float *C, const int *ldC,
|
||||
const float *D, const int *ldD, const float *E, const int *ldE,
|
||||
float *F, const int *ldF,
|
||||
const char *trans, const blasint *ijob, const blasint *m, const blasint *n,
|
||||
const float *A, const blasint *ldA, const float *B, const blasint *ldB,
|
||||
float *C, const blasint *ldC,
|
||||
const float *D, const blasint *ldD, const float *E, const blasint *ldE,
|
||||
float *F, const blasint *ldF,
|
||||
float *scale, float *dif,
|
||||
float *Work, const int *lWork, int *iWork, int *info
|
||||
float *Work, const blasint *lWork, blasint *iWork, blasint *info
|
||||
) {
|
||||
|
||||
// Parse arguments
|
||||
const int notran = LAPACK(lsame)(trans, "N");
|
||||
const int tran = LAPACK(lsame)(trans, "T");
|
||||
const blasint notran = LAPACK(lsame)(trans, "N");
|
||||
const blasint tran = LAPACK(lsame)(trans, "T");
|
||||
|
||||
// Compute work buffer size
|
||||
int lwmin = 1;
|
||||
blasint lwmin = 1;
|
||||
if (notran && (*ijob == 1 || *ijob == 2))
|
||||
lwmin = MAX(1, 2 * *m * *n);
|
||||
*info = 0;
|
||||
|
|
@ -58,8 +58,8 @@ void RELAPACK_stgsyl(
|
|||
else if (*lWork < lwmin && *lWork != -1)
|
||||
*info = -20;
|
||||
if (*info) {
|
||||
const int minfo = -*info;
|
||||
LAPACK(xerbla)("STGSYL", &minfo);
|
||||
const blasint minfo = -*info;
|
||||
LAPACK(xerbla)("STGSYL", &minfo, strlen("STGSYL"));
|
||||
return;
|
||||
}
|
||||
|
||||
|
|
@ -75,8 +75,8 @@ void RELAPACK_stgsyl(
|
|||
// Constant
|
||||
const float ZERO[] = { 0. };
|
||||
|
||||
int isolve = 1;
|
||||
int ifunc = 0;
|
||||
blasint isolve = 1;
|
||||
blasint ifunc = 0;
|
||||
if (notran) {
|
||||
if (*ijob >= 3) {
|
||||
ifunc = *ijob - 2;
|
||||
|
|
@ -87,12 +87,12 @@ void RELAPACK_stgsyl(
|
|||
}
|
||||
|
||||
float scale2;
|
||||
int iround;
|
||||
blasint iround;
|
||||
for (iround = 1; iround <= isolve; iround++) {
|
||||
*scale = 1;
|
||||
float dscale = 0;
|
||||
float dsum = 1;
|
||||
int pq;
|
||||
blasint pq;
|
||||
RELAPACK_stgsyl_rec(&cleantrans, &ifunc, m, n, A, ldA, B, ldB, C, ldC, D, ldD, E, ldE, F, ldF, scale, &dsum, &dscale, iWork, &pq, info);
|
||||
if (dscale != 0) {
|
||||
if (*ijob == 1 || *ijob == 3)
|
||||
|
|
@ -121,13 +121,13 @@ void RELAPACK_stgsyl(
|
|||
|
||||
/** stgsyl's recursive vompute kernel */
|
||||
static void RELAPACK_stgsyl_rec(
|
||||
const char *trans, const int *ifunc, const int *m, const int *n,
|
||||
const float *A, const int *ldA, const float *B, const int *ldB,
|
||||
float *C, const int *ldC,
|
||||
const float *D, const int *ldD, const float *E, const int *ldE,
|
||||
float *F, const int *ldF,
|
||||
const char *trans, const blasint *ifunc, const blasint *m, const blasint *n,
|
||||
const float *A, const blasint *ldA, const float *B, const blasint *ldB,
|
||||
float *C, const blasint *ldC,
|
||||
const float *D, const blasint *ldD, const float *E, const blasint *ldE,
|
||||
float *F, const blasint *ldF,
|
||||
float *scale, float *dsum, float *dscale,
|
||||
int *iWork, int *pq, int *info
|
||||
blasint *iWork, blasint *pq, blasint *info
|
||||
) {
|
||||
|
||||
if (*m <= MAX(CROSSOVER_STGSYL, 1) && *n <= MAX(CROSSOVER_STGSYL, 1)) {
|
||||
|
|
@ -139,20 +139,20 @@ static void RELAPACK_stgsyl_rec(
|
|||
// Constants
|
||||
const float ONE[] = { 1. };
|
||||
const float MONE[] = { -1. };
|
||||
const int iONE[] = { 1 };
|
||||
const blasint iONE[] = { 1 };
|
||||
|
||||
// Outputs
|
||||
float scale1[] = { 1. };
|
||||
float scale2[] = { 1. };
|
||||
int info1[] = { 0 };
|
||||
int info2[] = { 0 };
|
||||
blasint info1[] = { 0 };
|
||||
blasint info2[] = { 0 };
|
||||
|
||||
if (*m > *n) {
|
||||
// Splitting
|
||||
int m1 = SREC_SPLIT(*m);
|
||||
blasint m1 = SREC_SPLIT(*m);
|
||||
if (A[m1 + *ldA * (m1 - 1)])
|
||||
m1++;
|
||||
const int m2 = *m - m1;
|
||||
const blasint m2 = *m - m1;
|
||||
|
||||
// A_TL A_TR
|
||||
// 0 A_BR
|
||||
|
|
@ -210,10 +210,10 @@ static void RELAPACK_stgsyl_rec(
|
|||
}
|
||||
} else {
|
||||
// Splitting
|
||||
int n1 = SREC_SPLIT(*n);
|
||||
blasint n1 = SREC_SPLIT(*n);
|
||||
if (B[n1 + *ldB * (n1 - 1)])
|
||||
n1++;
|
||||
const int n2 = *n - n1;
|
||||
const blasint n2 = *n - n1;
|
||||
|
||||
// B_TL B_TR
|
||||
// 0 B_BR
|
||||
|
|
|
|||
|
|
@ -1,8 +1,8 @@
|
|||
#include "relapack.h"
|
||||
|
||||
static void RELAPACK_strsyl_rec(const char *, const char *, const int *,
|
||||
const int *, const int *, const float *, const int *, const float *,
|
||||
const int *, float *, const int *, float *, int *);
|
||||
static void RELAPACK_strsyl_rec(const char *, const char *, const blasint *,
|
||||
const blasint *, const blasint *, const float *, const blasint *, const float *,
|
||||
const blasint *, float *, const blasint *, float *, blasint *);
|
||||
|
||||
|
||||
/** STRSYL solves the real Sylvester matrix equation.
|
||||
|
|
@ -12,20 +12,20 @@ static void RELAPACK_strsyl_rec(const char *, const char *, const int *,
|
|||
* http://www.netlib.org/lapack/explore-html/d4/d7d/strsyl_8f.html
|
||||
* */
|
||||
void RELAPACK_strsyl(
|
||||
const char *tranA, const char *tranB, const int *isgn,
|
||||
const int *m, const int *n,
|
||||
const float *A, const int *ldA, const float *B, const int *ldB,
|
||||
float *C, const int *ldC, float *scale,
|
||||
int *info
|
||||
const char *tranA, const char *tranB, const blasint *isgn,
|
||||
const blasint *m, const blasint *n,
|
||||
const float *A, const blasint *ldA, const float *B, const blasint *ldB,
|
||||
float *C, const blasint *ldC, float *scale,
|
||||
blasint *info
|
||||
) {
|
||||
|
||||
// Check arguments
|
||||
const int notransA = LAPACK(lsame)(tranA, "N");
|
||||
const int transA = LAPACK(lsame)(tranA, "T");
|
||||
const int ctransA = LAPACK(lsame)(tranA, "C");
|
||||
const int notransB = LAPACK(lsame)(tranB, "N");
|
||||
const int transB = LAPACK(lsame)(tranB, "T");
|
||||
const int ctransB = LAPACK(lsame)(tranB, "C");
|
||||
const blasint notransA = LAPACK(lsame)(tranA, "N");
|
||||
const blasint transA = LAPACK(lsame)(tranA, "T");
|
||||
const blasint ctransA = LAPACK(lsame)(tranA, "C");
|
||||
const blasint notransB = LAPACK(lsame)(tranB, "N");
|
||||
const blasint transB = LAPACK(lsame)(tranB, "T");
|
||||
const blasint ctransB = LAPACK(lsame)(tranB, "C");
|
||||
*info = 0;
|
||||
if (!transA && !ctransA && !notransA)
|
||||
*info = -1;
|
||||
|
|
@ -44,8 +44,8 @@ void RELAPACK_strsyl(
|
|||
else if (*ldC < MAX(1, *m))
|
||||
*info = -11;
|
||||
if (*info) {
|
||||
const int minfo = -*info;
|
||||
LAPACK(xerbla)("STRSYL", &minfo);
|
||||
const blasint minfo = -*info;
|
||||
LAPACK(xerbla)("STRSYL", &minfo, strlen("STRSYL"));
|
||||
return;
|
||||
}
|
||||
|
||||
|
|
@ -60,11 +60,11 @@ void RELAPACK_strsyl(
|
|||
|
||||
/** strsyl's recursive compute kernel */
|
||||
static void RELAPACK_strsyl_rec(
|
||||
const char *tranA, const char *tranB, const int *isgn,
|
||||
const int *m, const int *n,
|
||||
const float *A, const int *ldA, const float *B, const int *ldB,
|
||||
float *C, const int *ldC, float *scale,
|
||||
int *info
|
||||
const char *tranA, const char *tranB, const blasint *isgn,
|
||||
const blasint *m, const blasint *n,
|
||||
const float *A, const blasint *ldA, const float *B, const blasint *ldB,
|
||||
float *C, const blasint *ldC, float *scale,
|
||||
blasint *info
|
||||
) {
|
||||
|
||||
if (*m <= MAX(CROSSOVER_STRSYL, 1) && *n <= MAX(CROSSOVER_STRSYL, 1)) {
|
||||
|
|
@ -77,20 +77,20 @@ static void RELAPACK_strsyl_rec(
|
|||
const float ONE[] = { 1. };
|
||||
const float MONE[] = { -1. };
|
||||
const float MSGN[] = { -*isgn };
|
||||
const int iONE[] = { 1 };
|
||||
const blasint iONE[] = { 1 };
|
||||
|
||||
// Outputs
|
||||
float scale1[] = { 1. };
|
||||
float scale2[] = { 1. };
|
||||
int info1[] = { 0 };
|
||||
int info2[] = { 0 };
|
||||
blasint info1[] = { 0 };
|
||||
blasint info2[] = { 0 };
|
||||
|
||||
if (*m > *n) {
|
||||
// Splitting
|
||||
int m1 = SREC_SPLIT(*m);
|
||||
blasint m1 = SREC_SPLIT(*m);
|
||||
if (A[m1 + *ldA * (m1 - 1)])
|
||||
m1++;
|
||||
const int m2 = *m - m1;
|
||||
const blasint m2 = *m - m1;
|
||||
|
||||
// A_TL A_TR
|
||||
// 0 A_BR
|
||||
|
|
@ -126,10 +126,10 @@ static void RELAPACK_strsyl_rec(
|
|||
}
|
||||
} else {
|
||||
// Splitting
|
||||
int n1 = SREC_SPLIT(*n);
|
||||
blasint n1 = SREC_SPLIT(*n);
|
||||
if (B[n1 + *ldB * (n1 - 1)])
|
||||
n1++;
|
||||
const int n2 = *n - n1;
|
||||
const blasint n2 = *n - n1;
|
||||
|
||||
// B_TL B_TR
|
||||
// 0 B_BR
|
||||
|
|
|
|||
|
|
@ -14,48 +14,48 @@
|
|||
|
||||
/* Table of constant values */
|
||||
|
||||
static int c__1 = 1;
|
||||
static int c_false = FALSE_;
|
||||
static int c__2 = 2;
|
||||
static blasint c__1 = 1;
|
||||
static blasint c_false = FALSE_;
|
||||
static blasint c__2 = 2;
|
||||
static float c_b26 = 1.f;
|
||||
static float c_b30 = 0.f;
|
||||
static int c_true = TRUE_;
|
||||
static blasint c_true = TRUE_;
|
||||
|
||||
void RELAPACK_strsyl_rec2(char *trana, char *tranb, int *isgn, int
|
||||
*m, int *n, float *a, int *lda, float *b, int *ldb, float *
|
||||
c__, int *ldc, float *scale, int *info, ftnlen trana_len,
|
||||
void RELAPACK_strsyl_rec2(char *trana, char *tranb, blasint *isgn, int
|
||||
*m, blasint *n, float *a, blasint *lda, float *b, blasint *ldb, float *
|
||||
c__, blasint *ldc, float *scale, blasint *info, ftnlen trana_len,
|
||||
ftnlen tranb_len)
|
||||
{
|
||||
/* System generated locals */
|
||||
int a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2,
|
||||
blasint a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2,
|
||||
i__3, i__4;
|
||||
float r__1, r__2;
|
||||
|
||||
/* Local variables */
|
||||
static int j, k, l;
|
||||
static blasint j, k, l;
|
||||
static float x[4] /* was [2][2] */;
|
||||
static int k1, k2, l1, l2;
|
||||
static blasint k1, k2, l1, l2;
|
||||
static float a11, db, da11, vec[4] /* was [2][2] */, dum[1], eps, sgn;
|
||||
static int ierr;
|
||||
static blasint ierr;
|
||||
static float smin;
|
||||
extern float sdot_(int *, float *, int *, float *, int *);
|
||||
extern float sdot_(int *, float *, blasint *, float *, blasint *);
|
||||
static float suml, sumr;
|
||||
extern int lsame_(char *, char *, ftnlen, ftnlen);
|
||||
extern /* Subroutine */ int sscal_(int *, float *, float *, int *);
|
||||
static int knext, lnext;
|
||||
extern blasint lsame_(char *, char *, ftnlen, ftnlen);
|
||||
extern /* Subroutine */ blasint sscal_(int *, float *, float *, blasint *);
|
||||
static blasint knext, lnext;
|
||||
static float xnorm;
|
||||
extern /* Subroutine */ int slaln2_(int *, int *, int *, float
|
||||
*, float *, float *, int *, float *, float *, float *, int *,
|
||||
float *, float *, float *, int *, float *, float *, int *),
|
||||
slasy2_(int *, int *, int *, int *, int *,
|
||||
float *, int *, float *, int *, float *, int *, float *,
|
||||
float *, int *, float *, int *), slabad_(float *, float *);
|
||||
extern /* Subroutine */ blasint slaln2_(int *, blasint *, blasint *, float
|
||||
*, float *, float *, blasint *, float *, float *, float *, blasint *,
|
||||
float *, float *, float *, blasint *, float *, float *, blasint *),
|
||||
slasy2_(int *, blasint *, blasint *, blasint *, blasint *,
|
||||
float *, blasint *, float *, blasint *, float *, blasint *, float *,
|
||||
float *, blasint *, float *, blasint *), slabad_(float *, float *);
|
||||
static float scaloc;
|
||||
extern float slamch_(char *, ftnlen), slange_(char *, int *,
|
||||
int *, float *, int *, float *, ftnlen);
|
||||
extern /* Subroutine */ int xerbla_(char *, int *, ftnlen);
|
||||
extern float slamch_(char *, ftnlen), slange_(char *, blasint *,
|
||||
blasint *, float *, blasint *, float *, ftnlen);
|
||||
extern /* Subroutine */ blasint xerbla_(char *, blasint *, ftnlen);
|
||||
static float bignum;
|
||||
static int notrna, notrnb;
|
||||
static blasint notrna, notrnb;
|
||||
static float smlnum;
|
||||
|
||||
/* Parameter adjustments */
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
#include "relapack.h"
|
||||
|
||||
static void RELAPACK_strtri_rec(const char *, const char *, const int *,
|
||||
float *, const int *, int *);
|
||||
static void RELAPACK_strtri_rec(const char *, const char *, const blasint *,
|
||||
float *, const blasint *, blasint *);
|
||||
|
||||
|
||||
/** CTRTRI computes the inverse of a real upper or lower triangular matrix A.
|
||||
|
|
@ -11,16 +11,16 @@ static void RELAPACK_strtri_rec(const char *, const char *, const int *,
|
|||
* http://www.netlib.org/lapack/explore-html/de/d76/strtri_8f.html
|
||||
* */
|
||||
void RELAPACK_strtri(
|
||||
const char *uplo, const char *diag, const int *n,
|
||||
float *A, const int *ldA,
|
||||
int *info
|
||||
const char *uplo, const char *diag, const blasint *n,
|
||||
float *A, const blasint *ldA,
|
||||
blasint *info
|
||||
) {
|
||||
|
||||
// Check arguments
|
||||
const int lower = LAPACK(lsame)(uplo, "L");
|
||||
const int upper = LAPACK(lsame)(uplo, "U");
|
||||
const int nounit = LAPACK(lsame)(diag, "N");
|
||||
const int unit = LAPACK(lsame)(diag, "U");
|
||||
const blasint lower = LAPACK(lsame)(uplo, "L");
|
||||
const blasint upper = LAPACK(lsame)(uplo, "U");
|
||||
const blasint nounit = LAPACK(lsame)(diag, "N");
|
||||
const blasint unit = LAPACK(lsame)(diag, "U");
|
||||
*info = 0;
|
||||
if (!lower && !upper)
|
||||
*info = -1;
|
||||
|
|
@ -31,8 +31,8 @@ void RELAPACK_strtri(
|
|||
else if (*ldA < MAX(1, *n))
|
||||
*info = -5;
|
||||
if (*info) {
|
||||
const int minfo = -*info;
|
||||
LAPACK(xerbla)("STRTRI", &minfo);
|
||||
const blasint minfo = -*info;
|
||||
LAPACK(xerbla)("STRTRI", &minfo, strlen("STRTRI"));
|
||||
return;
|
||||
}
|
||||
|
||||
|
|
@ -42,7 +42,7 @@ void RELAPACK_strtri(
|
|||
|
||||
// check for singularity
|
||||
if (nounit) {
|
||||
int i;
|
||||
blasint i;
|
||||
for (i = 0; i < *n; i++)
|
||||
if (A[i + *ldA * i] == 0) {
|
||||
*info = i;
|
||||
|
|
@ -57,9 +57,9 @@ void RELAPACK_strtri(
|
|||
|
||||
/** strtri's recursive compute kernel */
|
||||
static void RELAPACK_strtri_rec(
|
||||
const char *uplo, const char *diag, const int *n,
|
||||
float *A, const int *ldA,
|
||||
int *info
|
||||
const char *uplo, const char *diag, const blasint *n,
|
||||
float *A, const blasint *ldA,
|
||||
blasint *info
|
||||
){
|
||||
|
||||
if (*n <= MAX(CROSSOVER_STRTRI, 1)) {
|
||||
|
|
@ -73,8 +73,8 @@ static void RELAPACK_strtri_rec(
|
|||
const float MONE[] = { -1. };
|
||||
|
||||
// Splitting
|
||||
const int n1 = SREC_SPLIT(*n);
|
||||
const int n2 = *n - n1;
|
||||
const blasint n1 = SREC_SPLIT(*n);
|
||||
const blasint n2 = *n - n1;
|
||||
|
||||
// A_TL A_TR
|
||||
// A_BL A_BR
|
||||
|
|
|
|||
|
|
@ -1,9 +1,9 @@
|
|||
#include "relapack.h"
|
||||
#include "stdlib.h"
|
||||
|
||||
static void RELAPACK_zgbtrf_rec(const int *, const int *, const int *,
|
||||
const int *, double *, const int *, int *, double *, const int *, double *,
|
||||
const int *, int *);
|
||||
static void RELAPACK_zgbtrf_rec(const blasint *, const blasint *, const blasint *,
|
||||
const blasint *, double *, const blasint *, blasint *, double *, const blasint *, double *,
|
||||
const blasint *, blasint *);
|
||||
|
||||
|
||||
/** ZGBTRF computes an LU factorization of a complex m-by-n band matrix A using partial pivoting with row interchanges.
|
||||
|
|
@ -13,9 +13,9 @@ static void RELAPACK_zgbtrf_rec(const int *, const int *, const int *,
|
|||
* http://www.netlib.org/lapack/explore-html/dc/dcb/zgbtrf_8f.html
|
||||
* */
|
||||
void RELAPACK_zgbtrf(
|
||||
const int *m, const int *n, const int *kl, const int *ku,
|
||||
double *Ab, const int *ldAb, int *ipiv,
|
||||
int *info
|
||||
const blasint *m, const blasint *n, const blasint *kl, const blasint *ku,
|
||||
double *Ab, const blasint *ldAb, blasint *ipiv,
|
||||
blasint *info
|
||||
) {
|
||||
|
||||
// Check arguments
|
||||
|
|
@ -31,8 +31,8 @@ void RELAPACK_zgbtrf(
|
|||
else if (*ldAb < 2 * *kl + *ku + 1)
|
||||
*info = -6;
|
||||
if (*info) {
|
||||
const int minfo = -*info;
|
||||
LAPACK(xerbla)("ZGBTRF", &minfo);
|
||||
const blasint minfo = -*info;
|
||||
LAPACK(xerbla)("ZGBTRF", &minfo, strlen("ZGBTRF"));
|
||||
return;
|
||||
}
|
||||
|
||||
|
|
@ -40,14 +40,14 @@ void RELAPACK_zgbtrf(
|
|||
const double ZERO[] = { 0., 0. };
|
||||
|
||||
// Result upper band width
|
||||
const int kv = *ku + *kl;
|
||||
const blasint kv = *ku + *kl;
|
||||
|
||||
// Unskew A
|
||||
const int ldA[] = { *ldAb - 1 };
|
||||
const blasint ldA[] = { *ldAb - 1 };
|
||||
double *const A = Ab + 2 * kv;
|
||||
|
||||
// Zero upper diagonal fill-in elements
|
||||
int i, j;
|
||||
blasint i, j;
|
||||
for (j = 0; j < *n; j++) {
|
||||
double *const A_j = A + 2 * *ldA * j;
|
||||
for (i = MAX(0, j - kv); i < j - *ku; i++)
|
||||
|
|
@ -55,11 +55,11 @@ void RELAPACK_zgbtrf(
|
|||
}
|
||||
|
||||
// Allocate work space
|
||||
const int n1 = ZREC_SPLIT(*n);
|
||||
const int mWorkl = (kv > n1) ? MAX(1, *m - *kl) : kv;
|
||||
const int nWorkl = (kv > n1) ? n1 : kv;
|
||||
const int mWorku = (*kl > n1) ? n1 : *kl;
|
||||
const int nWorku = (*kl > n1) ? MAX(0, *n - *kl) : *kl;
|
||||
const blasint n1 = ZREC_SPLIT(*n);
|
||||
const blasint mWorkl = (kv > n1) ? MAX(1, *m - *kl) : kv;
|
||||
const blasint nWorkl = (kv > n1) ? n1 : kv;
|
||||
const blasint mWorku = (*kl > n1) ? n1 : *kl;
|
||||
const blasint nWorku = (*kl > n1) ? MAX(0, *n - *kl) : *kl;
|
||||
double *Workl = malloc(mWorkl * nWorkl * 2 * sizeof(double));
|
||||
double *Worku = malloc(mWorku * nWorku * 2 * sizeof(double));
|
||||
LAPACK(zlaset)("L", &mWorkl, &nWorkl, ZERO, ZERO, Workl, &mWorkl);
|
||||
|
|
@ -76,10 +76,10 @@ void RELAPACK_zgbtrf(
|
|||
|
||||
/** zgbtrf's recursive compute kernel */
|
||||
static void RELAPACK_zgbtrf_rec(
|
||||
const int *m, const int *n, const int *kl, const int *ku,
|
||||
double *Ab, const int *ldAb, int *ipiv,
|
||||
double *Workl, const int *ldWorkl, double *Worku, const int *ldWorku,
|
||||
int *info
|
||||
const blasint *m, const blasint *n, const blasint *kl, const blasint *ku,
|
||||
double *Ab, const blasint *ldAb, blasint *ipiv,
|
||||
double *Workl, const blasint *ldWorkl, double *Worku, const blasint *ldWorku,
|
||||
blasint *info
|
||||
) {
|
||||
|
||||
if (*n <= MAX(CROSSOVER_ZGBTRF, 1)) {
|
||||
|
|
@ -91,25 +91,25 @@ static void RELAPACK_zgbtrf_rec(
|
|||
// Constants
|
||||
const double ONE[] = { 1., 0. };
|
||||
const double MONE[] = { -1., 0. };
|
||||
const int iONE[] = { 1 };
|
||||
const blasint iONE[] = { 1 };
|
||||
|
||||
// Loop iterators
|
||||
int i, j;
|
||||
blasint i, j;
|
||||
|
||||
// Output upper band width
|
||||
const int kv = *ku + *kl;
|
||||
const blasint kv = *ku + *kl;
|
||||
|
||||
// Unskew A
|
||||
const int ldA[] = { *ldAb - 1 };
|
||||
const blasint ldA[] = { *ldAb - 1 };
|
||||
double *const A = Ab + 2 * kv;
|
||||
|
||||
// Splitting
|
||||
const int n1 = MIN(ZREC_SPLIT(*n), *kl);
|
||||
const int n2 = *n - n1;
|
||||
const int m1 = MIN(n1, *m);
|
||||
const int m2 = *m - m1;
|
||||
const int mn1 = MIN(m1, n1);
|
||||
const int mn2 = MIN(m2, n2);
|
||||
const blasint n1 = MIN(ZREC_SPLIT(*n), *kl);
|
||||
const blasint n2 = *n - n1;
|
||||
const blasint m1 = MIN(n1, *m);
|
||||
const blasint m2 = *m - m1;
|
||||
const blasint mn1 = MIN(m1, n1);
|
||||
const blasint mn2 = MIN(m2, n2);
|
||||
|
||||
// Ab_L *
|
||||
// Ab_BR
|
||||
|
|
@ -129,14 +129,14 @@ static void RELAPACK_zgbtrf_rec(
|
|||
|
||||
// ipiv_T
|
||||
// ipiv_B
|
||||
int *const ipiv_T = ipiv;
|
||||
int *const ipiv_B = ipiv + n1;
|
||||
blasint *const ipiv_T = ipiv;
|
||||
blasint *const ipiv_B = ipiv + n1;
|
||||
|
||||
// Banded splitting
|
||||
const int n21 = MIN(n2, kv - n1);
|
||||
const int n22 = MIN(n2 - n21, n1);
|
||||
const int m21 = MIN(m2, *kl - m1);
|
||||
const int m22 = MIN(m2 - m21, m1);
|
||||
const blasint n21 = MIN(n2, kv - n1);
|
||||
const blasint n22 = MIN(n2 - n21, n1);
|
||||
const blasint m21 = MIN(m2, *kl - m1);
|
||||
const blasint m22 = MIN(m2 - m21, m1);
|
||||
|
||||
// n1 n21 n22
|
||||
// m * A_Rl ARr
|
||||
|
|
@ -164,7 +164,7 @@ static void RELAPACK_zgbtrf_rec(
|
|||
|
||||
// partially redo swaps in A_L
|
||||
for (i = 0; i < mn1; i++) {
|
||||
const int ip = ipiv_T[i] - 1;
|
||||
const blasint ip = ipiv_T[i] - 1;
|
||||
if (ip != i) {
|
||||
if (ip < *kl)
|
||||
BLAS(zswap)(&i, A_L + 2 * i, ldA, A_L + 2 * ip, ldA);
|
||||
|
|
@ -180,7 +180,7 @@ static void RELAPACK_zgbtrf_rec(
|
|||
for (j = 0; j < n22; j++) {
|
||||
double *const A_Rrj = A_Rr + 2 * *ldA * j;
|
||||
for (i = j; i < mn1; i++) {
|
||||
const int ip = ipiv_T[i] - 1;
|
||||
const blasint ip = ipiv_T[i] - 1;
|
||||
if (ip != i) {
|
||||
const double tmpr = A_Rrj[2 * i];
|
||||
const double tmpc = A_Rrj[2 * i + 1];
|
||||
|
|
@ -211,7 +211,7 @@ static void RELAPACK_zgbtrf_rec(
|
|||
|
||||
// partially undo swaps in A_L
|
||||
for (i = mn1 - 1; i >= 0; i--) {
|
||||
const int ip = ipiv_T[i] - 1;
|
||||
const blasint ip = ipiv_T[i] - 1;
|
||||
if (ip != i) {
|
||||
if (ip < *kl)
|
||||
BLAS(zswap)(&i, A_L + 2 * i, ldA, A_L + 2 * ip, ldA);
|
||||
|
|
|
|||
|
|
@ -1,12 +1,12 @@
|
|||
#include "relapack.h"
|
||||
|
||||
static void RELAPACK_zgemmt_rec(const char *, const char *, const char *,
|
||||
const int *, const int *, const double *, const double *, const int *,
|
||||
const double *, const int *, const double *, double *, const int *);
|
||||
const blasint *, const blasint *, const double *, const double *, const blasint *,
|
||||
const double *, const blasint *, const double *, double *, const blasint *);
|
||||
|
||||
static void RELAPACK_zgemmt_rec2(const char *, const char *, const char *,
|
||||
const int *, const int *, const double *, const double *, const int *,
|
||||
const double *, const int *, const double *, double *, const int *);
|
||||
const blasint *, const blasint *, const double *, const double *, const blasint *,
|
||||
const double *, const blasint *, const double *, double *, const blasint *);
|
||||
|
||||
|
||||
/** ZGEMMT computes a matrix-matrix product with general matrices but updates
|
||||
|
|
@ -20,10 +20,10 @@ static void RELAPACK_zgemmt_rec2(const char *, const char *, const char *,
|
|||
* */
|
||||
void RELAPACK_zgemmt(
|
||||
const char *uplo, const char *transA, const char *transB,
|
||||
const int *n, const int *k,
|
||||
const double *alpha, const double *A, const int *ldA,
|
||||
const double *B, const int *ldB,
|
||||
const double *beta, double *C, const int *ldC
|
||||
const blasint *n, const blasint *k,
|
||||
const double *alpha, const double *A, const blasint *ldA,
|
||||
const double *B, const blasint *ldB,
|
||||
const double *beta, double *C, const blasint *ldC
|
||||
) {
|
||||
|
||||
#if HAVE_XGEMMT
|
||||
|
|
@ -32,15 +32,15 @@ void RELAPACK_zgemmt(
|
|||
#else
|
||||
|
||||
// Check arguments
|
||||
const int lower = LAPACK(lsame)(uplo, "L");
|
||||
const int upper = LAPACK(lsame)(uplo, "U");
|
||||
const int notransA = LAPACK(lsame)(transA, "N");
|
||||
const int tranA = LAPACK(lsame)(transA, "T");
|
||||
const int ctransA = LAPACK(lsame)(transA, "C");
|
||||
const int notransB = LAPACK(lsame)(transB, "N");
|
||||
const int tranB = LAPACK(lsame)(transB, "T");
|
||||
const int ctransB = LAPACK(lsame)(transB, "C");
|
||||
int info = 0;
|
||||
const blasint lower = LAPACK(lsame)(uplo, "L");
|
||||
const blasint upper = LAPACK(lsame)(uplo, "U");
|
||||
const blasint notransA = LAPACK(lsame)(transA, "N");
|
||||
const blasint tranA = LAPACK(lsame)(transA, "T");
|
||||
const blasint ctransA = LAPACK(lsame)(transA, "C");
|
||||
const blasint notransB = LAPACK(lsame)(transB, "N");
|
||||
const blasint tranB = LAPACK(lsame)(transB, "T");
|
||||
const blasint ctransB = LAPACK(lsame)(transB, "C");
|
||||
blasint info = 0;
|
||||
if (!lower && !upper)
|
||||
info = 1;
|
||||
else if (!tranA && !ctransA && !notransA)
|
||||
|
|
@ -58,7 +58,7 @@ void RELAPACK_zgemmt(
|
|||
else if (*ldC < MAX(1, *n))
|
||||
info = 13;
|
||||
if (info) {
|
||||
LAPACK(xerbla)("ZGEMMT", &info);
|
||||
LAPACK(xerbla)("ZGEMMT", &info, strlen("ZGEMMT"));
|
||||
return;
|
||||
}
|
||||
|
||||
|
|
@ -76,10 +76,10 @@ void RELAPACK_zgemmt(
|
|||
/** zgemmt's recursive compute kernel */
|
||||
static void RELAPACK_zgemmt_rec(
|
||||
const char *uplo, const char *transA, const char *transB,
|
||||
const int *n, const int *k,
|
||||
const double *alpha, const double *A, const int *ldA,
|
||||
const double *B, const int *ldB,
|
||||
const double *beta, double *C, const int *ldC
|
||||
const blasint *n, const blasint *k,
|
||||
const double *alpha, const double *A, const blasint *ldA,
|
||||
const double *B, const blasint *ldB,
|
||||
const double *beta, double *C, const blasint *ldC
|
||||
) {
|
||||
|
||||
if (*n <= MAX(CROSSOVER_ZGEMMT, 1)) {
|
||||
|
|
@ -89,8 +89,8 @@ static void RELAPACK_zgemmt_rec(
|
|||
}
|
||||
|
||||
// Splitting
|
||||
const int n1 = ZREC_SPLIT(*n);
|
||||
const int n2 = *n - n1;
|
||||
const blasint n1 = ZREC_SPLIT(*n);
|
||||
const blasint n2 = *n - n1;
|
||||
|
||||
// A_T
|
||||
// A_B
|
||||
|
|
@ -126,16 +126,16 @@ static void RELAPACK_zgemmt_rec(
|
|||
/** zgemmt's unblocked compute kernel */
|
||||
static void RELAPACK_zgemmt_rec2(
|
||||
const char *uplo, const char *transA, const char *transB,
|
||||
const int *n, const int *k,
|
||||
const double *alpha, const double *A, const int *ldA,
|
||||
const double *B, const int *ldB,
|
||||
const double *beta, double *C, const int *ldC
|
||||
const blasint *n, const blasint *k,
|
||||
const double *alpha, const double *A, const blasint *ldA,
|
||||
const double *B, const blasint *ldB,
|
||||
const double *beta, double *C, const blasint *ldC
|
||||
) {
|
||||
|
||||
const int incB = (*transB == 'N') ? 1 : *ldB;
|
||||
const int incC = 1;
|
||||
const blasint incB = (*transB == 'N') ? 1 : *ldB;
|
||||
const blasint incC = 1;
|
||||
|
||||
int i;
|
||||
blasint i;
|
||||
for (i = 0; i < *n; i++) {
|
||||
// A_0
|
||||
// A_i
|
||||
|
|
@ -151,13 +151,13 @@ static void RELAPACK_zgemmt_rec2(
|
|||
double *const C_ii = C + 2 * *ldC * i + 2 * i;
|
||||
|
||||
if (*uplo == 'L') {
|
||||
const int nmi = *n - i;
|
||||
const blasint nmi = *n - i;
|
||||
if (*transA == 'N')
|
||||
BLAS(zgemv)(transA, &nmi, k, alpha, A_i, ldA, B_i, &incB, beta, C_ii, &incC);
|
||||
else
|
||||
BLAS(zgemv)(transA, k, &nmi, alpha, A_i, ldA, B_i, &incB, beta, C_ii, &incC);
|
||||
} else {
|
||||
const int ip1 = i + 1;
|
||||
const blasint ip1 = i + 1;
|
||||
if (*transA == 'N')
|
||||
BLAS(zgemv)(transA, &ip1, k, alpha, A_0, ldA, B_i, &incB, beta, C_0i, &incC);
|
||||
else
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
#include "relapack.h"
|
||||
|
||||
static void RELAPACK_zgetrf_rec(const int *, const int *, double *,
|
||||
const int *, int *, int *);
|
||||
static void RELAPACK_zgetrf_rec(const blasint *, const blasint *, double *,
|
||||
const blasint *, blasint *, blasint *);
|
||||
|
||||
|
||||
/** ZGETRF computes an LU factorization of a general M-by-N matrix A using partial pivoting with row interchanges.
|
||||
|
|
@ -11,9 +11,9 @@ static void RELAPACK_zgetrf_rec(const int *, const int *, double *,
|
|||
* http://www.netlib.org/lapack/explore-html/dd/dd1/zgetrf_8f.html
|
||||
* */
|
||||
void RELAPACK_zgetrf(
|
||||
const int *m, const int *n,
|
||||
double *A, const int *ldA, int *ipiv,
|
||||
int *info
|
||||
const blasint *m, const blasint *n,
|
||||
double *A, const blasint *ldA, blasint *ipiv,
|
||||
blasint *info
|
||||
) {
|
||||
|
||||
// Check arguments
|
||||
|
|
@ -25,12 +25,12 @@ void RELAPACK_zgetrf(
|
|||
else if (*ldA < MAX(1, *n))
|
||||
*info = -4;
|
||||
if (*info) {
|
||||
const int minfo = -*info;
|
||||
LAPACK(xerbla)("ZGETRF", &minfo);
|
||||
const blasint minfo = -*info;
|
||||
LAPACK(xerbla)("ZGETRF", &minfo, strlen("ZGETRF"));
|
||||
return;
|
||||
}
|
||||
|
||||
const int sn = MIN(*m, *n);
|
||||
const blasint sn = MIN(*m, *n);
|
||||
|
||||
RELAPACK_zgetrf_rec(m, &sn, A, ldA, ipiv, info);
|
||||
|
||||
|
|
@ -38,10 +38,10 @@ void RELAPACK_zgetrf(
|
|||
if (*m < *n) {
|
||||
// Constants
|
||||
const double ONE[] = { 1., 0. };
|
||||
const int iONE[] = { 1 };
|
||||
const blasint iONE[] = { 1 };
|
||||
|
||||
// Splitting
|
||||
const int rn = *n - *m;
|
||||
const blasint rn = *n - *m;
|
||||
|
||||
// A_L A_R
|
||||
const double *const A_L = A;
|
||||
|
|
@ -57,9 +57,9 @@ void RELAPACK_zgetrf(
|
|||
|
||||
/** zgetrf's recursive compute kernel */
|
||||
static void RELAPACK_zgetrf_rec(
|
||||
const int *m, const int *n,
|
||||
double *A, const int *ldA, int *ipiv,
|
||||
int *info
|
||||
const blasint *m, const blasint *n,
|
||||
double *A, const blasint *ldA, blasint *ipiv,
|
||||
blasint *info
|
||||
) {
|
||||
|
||||
if (*n <= MAX(CROSSOVER_ZGETRF, 1)) {
|
||||
|
|
@ -71,12 +71,12 @@ static void RELAPACK_zgetrf_rec(
|
|||
// Constants
|
||||
const double ONE[] = { 1., 0. };
|
||||
const double MONE[] = { -1., 0. };
|
||||
const int iONE[] = { 1. };
|
||||
const blasint iONE[] = { 1. };
|
||||
|
||||
// Splitting
|
||||
const int n1 = ZREC_SPLIT(*n);
|
||||
const int n2 = *n - n1;
|
||||
const int m2 = *m - n1;
|
||||
const blasint n1 = ZREC_SPLIT(*n);
|
||||
const blasint n2 = *n - n1;
|
||||
const blasint m2 = *m - n1;
|
||||
|
||||
// A_L A_R
|
||||
double *const A_L = A;
|
||||
|
|
@ -91,8 +91,8 @@ static void RELAPACK_zgetrf_rec(
|
|||
|
||||
// ipiv_T
|
||||
// ipiv_B
|
||||
int *const ipiv_T = ipiv;
|
||||
int *const ipiv_B = ipiv + n1;
|
||||
blasint *const ipiv_T = ipiv;
|
||||
blasint *const ipiv_B = ipiv + n1;
|
||||
|
||||
// recursion(A_L, ipiv_T)
|
||||
RELAPACK_zgetrf_rec(m, &n1, A_L, ldA, ipiv_T, info);
|
||||
|
|
@ -111,7 +111,7 @@ static void RELAPACK_zgetrf_rec(
|
|||
// apply pivots to A_BL
|
||||
LAPACK(zlaswp)(&n1, A_BL, ldA, iONE, &n2, ipiv_B, iONE);
|
||||
// shift pivots
|
||||
int i;
|
||||
blasint i;
|
||||
for (i = 0; i < n2; i++)
|
||||
ipiv_B[i] += n1;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -3,9 +3,9 @@
|
|||
#include "stdlib.h"
|
||||
#endif
|
||||
|
||||
static void RELAPACK_zhegst_rec(const int *, const char *, const int *,
|
||||
double *, const int *, const double *, const int *,
|
||||
double *, const int *, int *);
|
||||
static void RELAPACK_zhegst_rec(const blasint *, const char *, const blasint *,
|
||||
double *, const blasint *, const double *, const blasint *,
|
||||
double *, const blasint *, blasint *);
|
||||
|
||||
|
||||
/** ZHEGST reduces a complex Hermitian-definite generalized eigenproblem to standard form.
|
||||
|
|
@ -15,14 +15,14 @@ static void RELAPACK_zhegst_rec(const int *, const char *, const int *,
|
|||
* http://www.netlib.org/lapack/explore-html/dc/d68/zhegst_8f.html
|
||||
* */
|
||||
void RELAPACK_zhegst(
|
||||
const int *itype, const char *uplo, const int *n,
|
||||
double *A, const int *ldA, const double *B, const int *ldB,
|
||||
int *info
|
||||
const blasint *itype, const char *uplo, const blasint *n,
|
||||
double *A, const blasint *ldA, const double *B, const blasint *ldB,
|
||||
blasint *info
|
||||
) {
|
||||
|
||||
// Check arguments
|
||||
const int lower = LAPACK(lsame)(uplo, "L");
|
||||
const int upper = LAPACK(lsame)(uplo, "U");
|
||||
const blasint lower = LAPACK(lsame)(uplo, "L");
|
||||
const blasint upper = LAPACK(lsame)(uplo, "U");
|
||||
*info = 0;
|
||||
if (*itype < 1 || *itype > 3)
|
||||
*info = -1;
|
||||
|
|
@ -35,8 +35,8 @@ void RELAPACK_zhegst(
|
|||
else if (*ldB < MAX(1, *n))
|
||||
*info = -7;
|
||||
if (*info) {
|
||||
const int minfo = -*info;
|
||||
LAPACK(xerbla)("ZHEGST", &minfo);
|
||||
const blasint minfo = -*info;
|
||||
LAPACK(xerbla)("ZHEGST", &minfo, strlen("ZHEGST"));
|
||||
return;
|
||||
}
|
||||
|
||||
|
|
@ -45,9 +45,9 @@ void RELAPACK_zhegst(
|
|||
|
||||
// Allocate work space
|
||||
double *Work = NULL;
|
||||
int lWork = 0;
|
||||
blasint lWork = 0;
|
||||
#if XSYGST_ALLOW_MALLOC
|
||||
const int n1 = ZREC_SPLIT(*n);
|
||||
const blasint n1 = ZREC_SPLIT(*n);
|
||||
lWork = n1 * (*n - n1);
|
||||
Work = malloc(lWork * 2 * sizeof(double));
|
||||
if (!Work)
|
||||
|
|
@ -67,9 +67,9 @@ void RELAPACK_zhegst(
|
|||
|
||||
/** zhegst's recursive compute kernel */
|
||||
static void RELAPACK_zhegst_rec(
|
||||
const int *itype, const char *uplo, const int *n,
|
||||
double *A, const int *ldA, const double *B, const int *ldB,
|
||||
double *Work, const int *lWork, int *info
|
||||
const blasint *itype, const char *uplo, const blasint *n,
|
||||
double *A, const blasint *ldA, const double *B, const blasint *ldB,
|
||||
double *Work, const blasint *lWork, blasint *info
|
||||
) {
|
||||
|
||||
if (*n <= MAX(CROSSOVER_ZHEGST, 1)) {
|
||||
|
|
@ -84,14 +84,14 @@ static void RELAPACK_zhegst_rec(
|
|||
const double MONE[] = { -1., 0. };
|
||||
const double HALF[] = { .5, 0. };
|
||||
const double MHALF[] = { -.5, 0. };
|
||||
const int iONE[] = { 1 };
|
||||
const blasint iONE[] = { 1 };
|
||||
|
||||
// Loop iterator
|
||||
int i;
|
||||
blasint i;
|
||||
|
||||
// Splitting
|
||||
const int n1 = ZREC_SPLIT(*n);
|
||||
const int n2 = *n - n1;
|
||||
const blasint n1 = ZREC_SPLIT(*n);
|
||||
const blasint n2 = *n - n1;
|
||||
|
||||
// A_TL A_TR
|
||||
// A_BL A_BR
|
||||
|
|
|
|||
|
|
@ -3,8 +3,8 @@
|
|||
#include <stdlib.h>
|
||||
#endif
|
||||
|
||||
static void RELAPACK_zhetrf_rec(const char *, const int *, const int *, int *,
|
||||
double *, const int *, int *, double *, const int *, int *);
|
||||
static void RELAPACK_zhetrf_rec(const char *, const blasint *, const blasint *, blasint *,
|
||||
double *, const blasint *, blasint *, double *, const blasint *, blasint *);
|
||||
|
||||
|
||||
/** ZHETRF computes the factorization of a complex Hermitian matrix A using the Bunch-Kaufman diagonal pivoting method.
|
||||
|
|
@ -14,21 +14,21 @@ static void RELAPACK_zhetrf_rec(const char *, const int *, const int *, int *,
|
|||
* http://www.netlib.org/lapack/explore-html/d6/dd3/zhetrf_8f.html
|
||||
* */
|
||||
void RELAPACK_zhetrf(
|
||||
const char *uplo, const int *n,
|
||||
double *A, const int *ldA, int *ipiv,
|
||||
double *Work, const int *lWork, int *info
|
||||
const char *uplo, const blasint *n,
|
||||
double *A, const blasint *ldA, blasint *ipiv,
|
||||
double *Work, const blasint *lWork, blasint *info
|
||||
) {
|
||||
|
||||
// Required work size
|
||||
const int cleanlWork = *n * (*n / 2);
|
||||
int minlWork = cleanlWork;
|
||||
const blasint cleanlWork = *n * (*n / 2);
|
||||
blasint minlWork = cleanlWork;
|
||||
#if XSYTRF_ALLOW_MALLOC
|
||||
minlWork = 1;
|
||||
#endif
|
||||
|
||||
// Check arguments
|
||||
const int lower = LAPACK(lsame)(uplo, "L");
|
||||
const int upper = LAPACK(lsame)(uplo, "U");
|
||||
const blasint lower = LAPACK(lsame)(uplo, "L");
|
||||
const blasint upper = LAPACK(lsame)(uplo, "U");
|
||||
*info = 0;
|
||||
if (!lower && !upper)
|
||||
*info = -1;
|
||||
|
|
@ -55,8 +55,8 @@ void RELAPACK_zhetrf(
|
|||
#endif
|
||||
|
||||
if (*info) {
|
||||
const int minfo = -*info;
|
||||
LAPACK(xerbla)("ZHETRF", &minfo);
|
||||
const blasint minfo = -*info;
|
||||
LAPACK(xerbla)("ZHETRF", &minfo, strlen("ZHETRF"));
|
||||
return;
|
||||
}
|
||||
|
||||
|
|
@ -64,7 +64,7 @@ void RELAPACK_zhetrf(
|
|||
const char cleanuplo = lower ? 'L' : 'U';
|
||||
|
||||
// Dummy argument
|
||||
int nout;
|
||||
blasint nout;
|
||||
|
||||
// Recursive kernel
|
||||
RELAPACK_zhetrf_rec(&cleanuplo, n, n, &nout, A, ldA, ipiv, cleanWork, n, info);
|
||||
|
|
@ -78,13 +78,13 @@ void RELAPACK_zhetrf(
|
|||
|
||||
/** zhetrf's recursive compute kernel */
|
||||
static void RELAPACK_zhetrf_rec(
|
||||
const char *uplo, const int *n_full, const int *n, int *n_out,
|
||||
double *A, const int *ldA, int *ipiv,
|
||||
double *Work, const int *ldWork, int *info
|
||||
const char *uplo, const blasint *n_full, const blasint *n, blasint *n_out,
|
||||
double *A, const blasint *ldA, blasint *ipiv,
|
||||
double *Work, const blasint *ldWork, blasint *info
|
||||
) {
|
||||
|
||||
// top recursion level?
|
||||
const int top = *n_full == *n;
|
||||
const blasint top = *n_full == *n;
|
||||
|
||||
if (*n <= MAX(CROSSOVER_ZHETRF, 3)) {
|
||||
// Unblocked
|
||||
|
|
@ -96,31 +96,31 @@ static void RELAPACK_zhetrf_rec(
|
|||
return;
|
||||
}
|
||||
|
||||
int info1, info2;
|
||||
blasint info1, info2;
|
||||
|
||||
// Constants
|
||||
const double ONE[] = { 1., 0. };
|
||||
const double MONE[] = { -1., 0. };
|
||||
const int iONE[] = { 1 };
|
||||
const blasint iONE[] = { 1 };
|
||||
|
||||
const int n_rest = *n_full - *n;
|
||||
const blasint n_rest = *n_full - *n;
|
||||
|
||||
if (*uplo == 'L') {
|
||||
// Splitting (setup)
|
||||
int n1 = ZREC_SPLIT(*n);
|
||||
int n2 = *n - n1;
|
||||
blasint n1 = ZREC_SPLIT(*n);
|
||||
blasint n2 = *n - n1;
|
||||
|
||||
// Work_L *
|
||||
double *const Work_L = Work;
|
||||
|
||||
// recursion(A_L)
|
||||
int n1_out;
|
||||
blasint n1_out;
|
||||
RELAPACK_zhetrf_rec(uplo, n_full, &n1, &n1_out, A, ldA, ipiv, Work_L, ldWork, &info1);
|
||||
n1 = n1_out;
|
||||
|
||||
// Splitting (continued)
|
||||
n2 = *n - n1;
|
||||
const int n_full2 = *n_full - n1;
|
||||
const blasint n_full2 = *n_full - n1;
|
||||
|
||||
// * *
|
||||
// A_BL A_BR
|
||||
|
|
@ -136,23 +136,23 @@ static void RELAPACK_zhetrf_rec(
|
|||
// (top recursion level: use Work as Work_BR)
|
||||
double *const Work_BL = Work + 2 * n1;
|
||||
double *const Work_BR = top ? Work : Work + 2 * *ldWork * n1 + 2 * n1;
|
||||
const int ldWork_BR = top ? n2 : *ldWork;
|
||||
const blasint ldWork_BR = top ? n2 : *ldWork;
|
||||
|
||||
// ipiv_T
|
||||
// ipiv_B
|
||||
int *const ipiv_B = ipiv + n1;
|
||||
blasint *const ipiv_B = ipiv + n1;
|
||||
|
||||
// A_BR = A_BR - A_BL Work_BL'
|
||||
RELAPACK_zgemmt(uplo, "N", "T", &n2, &n1, MONE, A_BL, ldA, Work_BL, ldWork, ONE, A_BR, ldA);
|
||||
BLAS(zgemm)("N", "T", &n_rest, &n2, &n1, MONE, A_BL_B, ldA, Work_BL, ldWork, ONE, A_BR_B, ldA);
|
||||
|
||||
// recursion(A_BR)
|
||||
int n2_out;
|
||||
blasint n2_out;
|
||||
RELAPACK_zhetrf_rec(uplo, &n_full2, &n2, &n2_out, A_BR, ldA, ipiv_B, Work_BR, &ldWork_BR, &info2);
|
||||
|
||||
if (n2_out != n2) {
|
||||
// undo 1 column of updates
|
||||
const int n_restp1 = n_rest + 1;
|
||||
const blasint n_restp1 = n_rest + 1;
|
||||
|
||||
// last column of A_BR
|
||||
double *const A_BR_r = A_BR + 2 * *ldA * n2_out + 2 * n2_out;
|
||||
|
|
@ -169,7 +169,7 @@ static void RELAPACK_zhetrf_rec(
|
|||
n2 = n2_out;
|
||||
|
||||
// shift pivots
|
||||
int i;
|
||||
blasint i;
|
||||
for (i = 0; i < n2; i++)
|
||||
if (ipiv_B[i] > 0)
|
||||
ipiv_B[i] += n1;
|
||||
|
|
@ -180,22 +180,22 @@ static void RELAPACK_zhetrf_rec(
|
|||
*n_out = n1 + n2;
|
||||
} else {
|
||||
// Splitting (setup)
|
||||
int n2 = ZREC_SPLIT(*n);
|
||||
int n1 = *n - n2;
|
||||
blasint n2 = ZREC_SPLIT(*n);
|
||||
blasint n1 = *n - n2;
|
||||
|
||||
// * Work_R
|
||||
// (top recursion level: use Work as Work_R)
|
||||
double *const Work_R = top ? Work : Work + 2 * *ldWork * n1;
|
||||
|
||||
// recursion(A_R)
|
||||
int n2_out;
|
||||
blasint n2_out;
|
||||
RELAPACK_zhetrf_rec(uplo, n_full, &n2, &n2_out, A, ldA, ipiv, Work_R, ldWork, &info2);
|
||||
const int n2_diff = n2 - n2_out;
|
||||
const blasint n2_diff = n2 - n2_out;
|
||||
n2 = n2_out;
|
||||
|
||||
// Splitting (continued)
|
||||
n1 = *n - n2;
|
||||
const int n_full1 = *n_full - n2;
|
||||
const blasint n_full1 = *n_full - n2;
|
||||
|
||||
// * A_TL_T A_TR_T
|
||||
// * A_TL A_TR
|
||||
|
|
@ -211,19 +211,19 @@ static void RELAPACK_zhetrf_rec(
|
|||
// (top recursion level: Work_R was Work)
|
||||
double *const Work_L = Work;
|
||||
double *const Work_TR = Work + 2 * *ldWork * (top ? n2_diff : n1) + 2 * n_rest;
|
||||
const int ldWork_L = top ? n1 : *ldWork;
|
||||
const blasint ldWork_L = top ? n1 : *ldWork;
|
||||
|
||||
// A_TL = A_TL - A_TR Work_TR'
|
||||
RELAPACK_zgemmt(uplo, "N", "T", &n1, &n2, MONE, A_TR, ldA, Work_TR, ldWork, ONE, A_TL, ldA);
|
||||
BLAS(zgemm)("N", "T", &n_rest, &n1, &n2, MONE, A_TR_T, ldA, Work_TR, ldWork, ONE, A_TL_T, ldA);
|
||||
|
||||
// recursion(A_TL)
|
||||
int n1_out;
|
||||
blasint n1_out;
|
||||
RELAPACK_zhetrf_rec(uplo, &n_full1, &n1, &n1_out, A, ldA, ipiv, Work_L, &ldWork_L, &info1);
|
||||
|
||||
if (n1_out != n1) {
|
||||
// undo 1 column of updates
|
||||
const int n_restp1 = n_rest + 1;
|
||||
const blasint n_restp1 = n_rest + 1;
|
||||
|
||||
// A_TL_T_l = A_TL_T_l + A_TR_T Work_TR_t'
|
||||
BLAS(zgemv)("N", &n_restp1, &n2, ONE, A_TR_T, ldA, Work_TR, ldWork, ONE, A_TL_T, iONE);
|
||||
|
|
|
|||
|
|
@ -15,7 +15,7 @@
|
|||
/* Table of constant values */
|
||||
|
||||
static doublecomplex c_b1 = {1.,0.};
|
||||
static int c__1 = 1;
|
||||
static blasint c__1 = 1;
|
||||
|
||||
/** ZHETRF_REC2 computes a partial factorization of a complex Hermitian indefinite matrix using the Bunch-Kau fman diagonal pivoting method
|
||||
*
|
||||
|
|
@ -24,12 +24,12 @@ static int c__1 = 1;
|
|||
* The blocked BLAS Level 3 updates were removed and moved to the
|
||||
* recursive algorithm.
|
||||
* */
|
||||
/* Subroutine */ void RELAPACK_zhetrf_rec2(char *uplo, int *n, int *
|
||||
nb, int *kb, doublecomplex *a, int *lda, int *ipiv,
|
||||
doublecomplex *w, int *ldw, int *info, ftnlen uplo_len)
|
||||
/* Subroutine */ void RELAPACK_zhetrf_rec2(char *uplo, blasint *n, blasint *
|
||||
nb, blasint *kb, doublecomplex *a, blasint *lda, blasint *ipiv,
|
||||
doublecomplex *w, blasint *ldw, blasint *info, ftnlen uplo_len)
|
||||
{
|
||||
/* System generated locals */
|
||||
int a_dim1, a_offset, w_dim1, w_offset, i__1, i__2, i__3, i__4;
|
||||
blasint a_dim1, a_offset, w_dim1, w_offset, i__1, i__2, i__3, i__4;
|
||||
double d__1, d__2, d__3, d__4;
|
||||
doublecomplex z__1, z__2, z__3, z__4;
|
||||
|
||||
|
|
@ -39,26 +39,26 @@ static int c__1 = 1;
|
|||
doublecomplex *, doublecomplex *);
|
||||
|
||||
/* Local variables */
|
||||
static int j, k;
|
||||
static blasint j, k;
|
||||
static double t, r1;
|
||||
static doublecomplex d11, d21, d22;
|
||||
static int jj, kk, jp, kp, kw, kkw, imax, jmax;
|
||||
static blasint jj, kk, jp, kp, kw, kkw, imax, jmax;
|
||||
static double alpha;
|
||||
extern logical lsame_(char *, char *, ftnlen, ftnlen);
|
||||
static int kstep;
|
||||
extern /* Subroutine */ int zgemv_(char *, int *, int *,
|
||||
doublecomplex *, doublecomplex *, int *, doublecomplex *,
|
||||
int *, doublecomplex *, doublecomplex *, int *, ftnlen),
|
||||
zcopy_(int *, doublecomplex *, int *, doublecomplex *,
|
||||
int *), zswap_(int *, doublecomplex *, int *,
|
||||
doublecomplex *, int *);
|
||||
static blasint kstep;
|
||||
extern /* Subroutine */ blasint zgemv_(char *, blasint *, blasint *,
|
||||
doublecomplex *, doublecomplex *, blasint *, doublecomplex *,
|
||||
blasint *, doublecomplex *, doublecomplex *, blasint *, ftnlen),
|
||||
zcopy_(int *, doublecomplex *, blasint *, doublecomplex *,
|
||||
blasint *), zswap_(int *, doublecomplex *, blasint *,
|
||||
doublecomplex *, blasint *);
|
||||
static double absakk;
|
||||
extern /* Subroutine */ int zdscal_(int *, double *,
|
||||
doublecomplex *, int *);
|
||||
extern /* Subroutine */ blasint zdscal_(int *, double *,
|
||||
doublecomplex *, blasint *);
|
||||
static double colmax;
|
||||
extern /* Subroutine */ int zlacgv_(int *, doublecomplex *, int *)
|
||||
extern /* Subroutine */ blasint zlacgv_(int *, doublecomplex *, blasint *)
|
||||
;
|
||||
extern int izamax_(int *, doublecomplex *, int *);
|
||||
extern blasint izamax_(int *, doublecomplex *, blasint *);
|
||||
static double rowmax;
|
||||
|
||||
/* Parameter adjustments */
|
||||
|
|
|
|||
|
|
@ -3,8 +3,8 @@
|
|||
#include <stdlib.h>
|
||||
#endif
|
||||
|
||||
static void RELAPACK_zhetrf_rook_rec(const char *, const int *, const int *, int *,
|
||||
double *, const int *, int *, double *, const int *, int *);
|
||||
static void RELAPACK_zhetrf_rook_rec(const char *, const blasint *, const blasint *, blasint *,
|
||||
double *, const blasint *, blasint *, double *, const blasint *, blasint *);
|
||||
|
||||
|
||||
/** ZHETRF_ROOK computes the factorization of a complex Hermitian indefinite matrix using the bounded Bunch-Kaufman ("rook") diagonal pivoting method.
|
||||
|
|
@ -14,21 +14,21 @@ static void RELAPACK_zhetrf_rook_rec(const char *, const int *, const int *, int
|
|||
* http://www.netlib.org/lapack/explore-html/d6/d6f/zhetrf__rook_8f.html
|
||||
* */
|
||||
void RELAPACK_zhetrf_rook(
|
||||
const char *uplo, const int *n,
|
||||
double *A, const int *ldA, int *ipiv,
|
||||
double *Work, const int *lWork, int *info
|
||||
const char *uplo, const blasint *n,
|
||||
double *A, const blasint *ldA, blasint *ipiv,
|
||||
double *Work, const blasint *lWork, blasint *info
|
||||
) {
|
||||
|
||||
// Required work size
|
||||
const int cleanlWork = *n * (*n / 2);
|
||||
int minlWork = cleanlWork;
|
||||
const blasint cleanlWork = *n * (*n / 2);
|
||||
blasint minlWork = cleanlWork;
|
||||
#if XSYTRF_ALLOW_MALLOC
|
||||
minlWork = 1;
|
||||
#endif
|
||||
|
||||
// Check arguments
|
||||
const int lower = LAPACK(lsame)(uplo, "L");
|
||||
const int upper = LAPACK(lsame)(uplo, "U");
|
||||
const blasint lower = LAPACK(lsame)(uplo, "L");
|
||||
const blasint upper = LAPACK(lsame)(uplo, "U");
|
||||
*info = 0;
|
||||
if (!lower && !upper)
|
||||
*info = -1;
|
||||
|
|
@ -55,8 +55,8 @@ void RELAPACK_zhetrf_rook(
|
|||
#endif
|
||||
|
||||
if (*info) {
|
||||
const int minfo = -*info;
|
||||
LAPACK(xerbla)("ZHETRF", &minfo);
|
||||
const blasint minfo = -*info;
|
||||
LAPACK(xerbla)("ZHETRF", &minfo, strlen("ZHETRF"));
|
||||
return;
|
||||
}
|
||||
|
||||
|
|
@ -64,7 +64,7 @@ void RELAPACK_zhetrf_rook(
|
|||
const char cleanuplo = lower ? 'L' : 'U';
|
||||
|
||||
// Dummy argument
|
||||
int nout;
|
||||
blasint nout;
|
||||
|
||||
// Recursive kernel
|
||||
RELAPACK_zhetrf_rook_rec(&cleanuplo, n, n, &nout, A, ldA, ipiv, cleanWork, n, info);
|
||||
|
|
@ -78,13 +78,13 @@ void RELAPACK_zhetrf_rook(
|
|||
|
||||
/** zhetrf_rook's recursive compute kernel */
|
||||
static void RELAPACK_zhetrf_rook_rec(
|
||||
const char *uplo, const int *n_full, const int *n, int *n_out,
|
||||
double *A, const int *ldA, int *ipiv,
|
||||
double *Work, const int *ldWork, int *info
|
||||
const char *uplo, const blasint *n_full, const blasint *n, blasint *n_out,
|
||||
double *A, const blasint *ldA, blasint *ipiv,
|
||||
double *Work, const blasint *ldWork, blasint *info
|
||||
) {
|
||||
|
||||
// top recursion level?
|
||||
const int top = *n_full == *n;
|
||||
const blasint top = *n_full == *n;
|
||||
|
||||
if (*n <= MAX(CROSSOVER_ZHETRF_ROOK, 3)) {
|
||||
// Unblocked
|
||||
|
|
@ -96,31 +96,31 @@ static void RELAPACK_zhetrf_rook_rec(
|
|||
return;
|
||||
}
|
||||
|
||||
int info1, info2;
|
||||
blasint info1, info2;
|
||||
|
||||
// Constants
|
||||
const double ONE[] = { 1., 0. };
|
||||
const double MONE[] = { -1., 0. };
|
||||
const int iONE[] = { 1 };
|
||||
const blasint iONE[] = { 1 };
|
||||
|
||||
const int n_rest = *n_full - *n;
|
||||
const blasint n_rest = *n_full - *n;
|
||||
|
||||
if (*uplo == 'L') {
|
||||
// Splitting (setup)
|
||||
int n1 = ZREC_SPLIT(*n);
|
||||
int n2 = *n - n1;
|
||||
blasint n1 = ZREC_SPLIT(*n);
|
||||
blasint n2 = *n - n1;
|
||||
|
||||
// Work_L *
|
||||
double *const Work_L = Work;
|
||||
|
||||
// recursion(A_L)
|
||||
int n1_out;
|
||||
blasint n1_out;
|
||||
RELAPACK_zhetrf_rook_rec(uplo, n_full, &n1, &n1_out, A, ldA, ipiv, Work_L, ldWork, &info1);
|
||||
n1 = n1_out;
|
||||
|
||||
// Splitting (continued)
|
||||
n2 = *n - n1;
|
||||
const int n_full2 = *n_full - n1;
|
||||
const blasint n_full2 = *n_full - n1;
|
||||
|
||||
// * *
|
||||
// A_BL A_BR
|
||||
|
|
@ -136,23 +136,23 @@ static void RELAPACK_zhetrf_rook_rec(
|
|||
// (top recursion level: use Work as Work_BR)
|
||||
double *const Work_BL = Work + 2 * n1;
|
||||
double *const Work_BR = top ? Work : Work + 2 * *ldWork * n1 + 2 * n1;
|
||||
const int ldWork_BR = top ? n2 : *ldWork;
|
||||
const blasint ldWork_BR = top ? n2 : *ldWork;
|
||||
|
||||
// ipiv_T
|
||||
// ipiv_B
|
||||
int *const ipiv_B = ipiv + n1;
|
||||
blasint *const ipiv_B = ipiv + n1;
|
||||
|
||||
// A_BR = A_BR - A_BL Work_BL'
|
||||
RELAPACK_zgemmt(uplo, "N", "T", &n2, &n1, MONE, A_BL, ldA, Work_BL, ldWork, ONE, A_BR, ldA);
|
||||
BLAS(zgemm)("N", "T", &n_rest, &n2, &n1, MONE, A_BL_B, ldA, Work_BL, ldWork, ONE, A_BR_B, ldA);
|
||||
|
||||
// recursion(A_BR)
|
||||
int n2_out;
|
||||
blasint n2_out;
|
||||
RELAPACK_zhetrf_rook_rec(uplo, &n_full2, &n2, &n2_out, A_BR, ldA, ipiv_B, Work_BR, &ldWork_BR, &info2);
|
||||
|
||||
if (n2_out != n2) {
|
||||
// undo 1 column of updates
|
||||
const int n_restp1 = n_rest + 1;
|
||||
const blasint n_restp1 = n_rest + 1;
|
||||
|
||||
// last column of A_BR
|
||||
double *const A_BR_r = A_BR + 2 * *ldA * n2_out + 2 * n2_out;
|
||||
|
|
@ -169,7 +169,7 @@ static void RELAPACK_zhetrf_rook_rec(
|
|||
n2 = n2_out;
|
||||
|
||||
// shift pivots
|
||||
int i;
|
||||
blasint i;
|
||||
for (i = 0; i < n2; i++)
|
||||
if (ipiv_B[i] > 0)
|
||||
ipiv_B[i] += n1;
|
||||
|
|
@ -180,22 +180,22 @@ static void RELAPACK_zhetrf_rook_rec(
|
|||
*n_out = n1 + n2;
|
||||
} else {
|
||||
// Splitting (setup)
|
||||
int n2 = ZREC_SPLIT(*n);
|
||||
int n1 = *n - n2;
|
||||
blasint n2 = ZREC_SPLIT(*n);
|
||||
blasint n1 = *n - n2;
|
||||
|
||||
// * Work_R
|
||||
// (top recursion level: use Work as Work_R)
|
||||
double *const Work_R = top ? Work : Work + 2 * *ldWork * n1;
|
||||
|
||||
// recursion(A_R)
|
||||
int n2_out;
|
||||
blasint n2_out;
|
||||
RELAPACK_zhetrf_rook_rec(uplo, n_full, &n2, &n2_out, A, ldA, ipiv, Work_R, ldWork, &info2);
|
||||
const int n2_diff = n2 - n2_out;
|
||||
const blasint n2_diff = n2 - n2_out;
|
||||
n2 = n2_out;
|
||||
|
||||
// Splitting (continued)
|
||||
n1 = *n - n2;
|
||||
const int n_full1 = *n_full - n2;
|
||||
const blasint n_full1 = *n_full - n2;
|
||||
|
||||
// * A_TL_T A_TR_T
|
||||
// * A_TL A_TR
|
||||
|
|
@ -211,19 +211,19 @@ static void RELAPACK_zhetrf_rook_rec(
|
|||
// (top recursion level: Work_R was Work)
|
||||
double *const Work_L = Work;
|
||||
double *const Work_TR = Work + 2 * *ldWork * (top ? n2_diff : n1) + 2 * n_rest;
|
||||
const int ldWork_L = top ? n1 : *ldWork;
|
||||
const blasint ldWork_L = top ? n1 : *ldWork;
|
||||
|
||||
// A_TL = A_TL - A_TR Work_TR'
|
||||
RELAPACK_zgemmt(uplo, "N", "T", &n1, &n2, MONE, A_TR, ldA, Work_TR, ldWork, ONE, A_TL, ldA);
|
||||
BLAS(zgemm)("N", "T", &n_rest, &n1, &n2, MONE, A_TR_T, ldA, Work_TR, ldWork, ONE, A_TL_T, ldA);
|
||||
|
||||
// recursion(A_TL)
|
||||
int n1_out;
|
||||
blasint n1_out;
|
||||
RELAPACK_zhetrf_rook_rec(uplo, &n_full1, &n1, &n1_out, A, ldA, ipiv, Work_L, &ldWork_L, &info1);
|
||||
|
||||
if (n1_out != n1) {
|
||||
// undo 1 column of updates
|
||||
const int n_restp1 = n_rest + 1;
|
||||
const blasint n_restp1 = n_rest + 1;
|
||||
|
||||
// A_TL_T_l = A_TL_T_l + A_TR_T Work_TR_t'
|
||||
BLAS(zgemv)("N", &n_restp1, &n2, ONE, A_TR_T, ldA, Work_TR, ldWork, ONE, A_TL_T, iONE);
|
||||
|
|
|
|||
|
|
@ -15,7 +15,7 @@
|
|||
/* Table of constant values */
|
||||
|
||||
static doublecomplex c_b1 = {1.,0.};
|
||||
static int c__1 = 1;
|
||||
static blasint c__1 = 1;
|
||||
|
||||
/** ZHETRF_ROOK_REC2 computes a partial factorization of a complex Hermitian indefinite matrix using the boun ded Bunch-Kaufman ("rook") diagonal pivoting method
|
||||
*
|
||||
|
|
@ -24,12 +24,12 @@ static int c__1 = 1;
|
|||
* The blocked BLAS Level 3 updates were removed and moved to the
|
||||
* recursive algorithm.
|
||||
* */
|
||||
/* Subroutine */ void RELAPACK_zhetrf_rook_rec2(char *uplo, int *n,
|
||||
int *nb, int *kb, doublecomplex *a, int *lda, int *
|
||||
ipiv, doublecomplex *w, int *ldw, int *info, ftnlen uplo_len)
|
||||
/* Subroutine */ void RELAPACK_zhetrf_rook_rec2(char *uplo, blasint *n,
|
||||
int *nb, blasint *kb, doublecomplex *a, blasint *lda, blasint *
|
||||
ipiv, doublecomplex *w, blasint *ldw, blasint *info, ftnlen uplo_len)
|
||||
{
|
||||
/* System generated locals */
|
||||
int a_dim1, a_offset, w_dim1, w_offset, i__1, i__2, i__3, i__4;
|
||||
blasint a_dim1, a_offset, w_dim1, w_offset, i__1, i__2, i__3, i__4;
|
||||
double d__1, d__2;
|
||||
doublecomplex z__1, z__2, z__3, z__4, z__5;
|
||||
|
||||
|
|
@ -39,30 +39,30 @@ static int c__1 = 1;
|
|||
doublecomplex *, doublecomplex *);
|
||||
|
||||
/* Local variables */
|
||||
static int j, k, p;
|
||||
static blasint j, k, p;
|
||||
static double t, r1;
|
||||
static doublecomplex d11, d21, d22;
|
||||
static int ii, jj, kk, kp, kw, jp1, jp2, kkw;
|
||||
static blasint ii, jj, kk, kp, kw, jp1, jp2, kkw;
|
||||
static logical done;
|
||||
static int imax, jmax;
|
||||
static blasint imax, jmax;
|
||||
static double alpha;
|
||||
extern logical lsame_(char *, char *, ftnlen, ftnlen);
|
||||
static double dtemp, sfmin;
|
||||
static int itemp, kstep;
|
||||
extern /* Subroutine */ int zgemv_(char *, int *, int *,
|
||||
doublecomplex *, doublecomplex *, int *, doublecomplex *,
|
||||
int *, doublecomplex *, doublecomplex *, int *, ftnlen),
|
||||
zcopy_(int *, doublecomplex *, int *, doublecomplex *,
|
||||
int *), zswap_(int *, doublecomplex *, int *,
|
||||
doublecomplex *, int *);
|
||||
static blasint itemp, kstep;
|
||||
extern /* Subroutine */ blasint zgemv_(char *, blasint *, blasint *,
|
||||
doublecomplex *, doublecomplex *, blasint *, doublecomplex *,
|
||||
blasint *, doublecomplex *, doublecomplex *, blasint *, ftnlen),
|
||||
zcopy_(int *, doublecomplex *, blasint *, doublecomplex *,
|
||||
blasint *), zswap_(int *, doublecomplex *, blasint *,
|
||||
doublecomplex *, blasint *);
|
||||
extern double dlamch_(char *, ftnlen);
|
||||
static double absakk;
|
||||
extern /* Subroutine */ int zdscal_(int *, double *,
|
||||
doublecomplex *, int *);
|
||||
extern /* Subroutine */ blasint zdscal_(int *, double *,
|
||||
doublecomplex *, blasint *);
|
||||
static double colmax;
|
||||
extern /* Subroutine */ int zlacgv_(int *, doublecomplex *, int *)
|
||||
extern /* Subroutine */ blasint zlacgv_(int *, doublecomplex *, blasint *)
|
||||
;
|
||||
extern int izamax_(int *, doublecomplex *, int *);
|
||||
extern blasint izamax_(int *, doublecomplex *, blasint *);
|
||||
static double rowmax;
|
||||
|
||||
/* Parameter adjustments */
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
#include "relapack.h"
|
||||
|
||||
static void RELAPACK_zlauum_rec(const char *, const int *, double *,
|
||||
const int *, int *);
|
||||
static void RELAPACK_zlauum_rec(const char *, const blasint *, double *,
|
||||
const blasint *, blasint *);
|
||||
|
||||
|
||||
/** ZLAUUM computes the product U * U**H or L**H * L, where the triangular factor U or L is stored in the upper or lower triangular part of the array A.
|
||||
|
|
@ -11,14 +11,14 @@ static void RELAPACK_zlauum_rec(const char *, const int *, double *,
|
|||
* http://www.netlib.org/lapack/explore-html/d8/d45/zlauum_8f.html
|
||||
* */
|
||||
void RELAPACK_zlauum(
|
||||
const char *uplo, const int *n,
|
||||
double *A, const int *ldA,
|
||||
int *info
|
||||
const char *uplo, const blasint *n,
|
||||
double *A, const blasint *ldA,
|
||||
blasint *info
|
||||
) {
|
||||
|
||||
// Check arguments
|
||||
const int lower = LAPACK(lsame)(uplo, "L");
|
||||
const int upper = LAPACK(lsame)(uplo, "U");
|
||||
const blasint lower = LAPACK(lsame)(uplo, "L");
|
||||
const blasint upper = LAPACK(lsame)(uplo, "U");
|
||||
*info = 0;
|
||||
if (!lower && !upper)
|
||||
*info = -1;
|
||||
|
|
@ -27,8 +27,8 @@ void RELAPACK_zlauum(
|
|||
else if (*ldA < MAX(1, *n))
|
||||
*info = -4;
|
||||
if (*info) {
|
||||
const int minfo = -*info;
|
||||
LAPACK(xerbla)("ZLAUUM", &minfo);
|
||||
const blasint minfo = -*info;
|
||||
LAPACK(xerbla)("ZLAUUM", &minfo, strlen("ZLAUUM"));
|
||||
return;
|
||||
}
|
||||
|
||||
|
|
@ -42,9 +42,9 @@ void RELAPACK_zlauum(
|
|||
|
||||
/** zlauum's recursive compute kernel */
|
||||
static void RELAPACK_zlauum_rec(
|
||||
const char *uplo, const int *n,
|
||||
double *A, const int *ldA,
|
||||
int *info
|
||||
const char *uplo, const blasint *n,
|
||||
double *A, const blasint *ldA,
|
||||
blasint *info
|
||||
) {
|
||||
|
||||
if (*n <= MAX(CROSSOVER_ZLAUUM, 1)) {
|
||||
|
|
@ -57,8 +57,8 @@ static void RELAPACK_zlauum_rec(
|
|||
const double ONE[] = { 1., 0. };
|
||||
|
||||
// Splitting
|
||||
const int n1 = ZREC_SPLIT(*n);
|
||||
const int n2 = *n - n1;
|
||||
const blasint n1 = ZREC_SPLIT(*n);
|
||||
const blasint n2 = *n - n1;
|
||||
|
||||
// A_TL A_TR
|
||||
// A_BL A_BR
|
||||
|
|
|
|||
|
|
@ -1,8 +1,8 @@
|
|||
#include "relapack.h"
|
||||
#include "stdlib.h"
|
||||
|
||||
static void RELAPACK_zpbtrf_rec(const char *, const int *, const int *,
|
||||
double *, const int *, double *, const int *, int *);
|
||||
static void RELAPACK_zpbtrf_rec(const char *, const blasint *, const blasint *,
|
||||
double *, const blasint *, double *, const blasint *, blasint *);
|
||||
|
||||
|
||||
/** ZPBTRF computes the Cholesky factorization of a complex Hermitian positive definite band matrix A.
|
||||
|
|
@ -12,14 +12,14 @@ static void RELAPACK_zpbtrf_rec(const char *, const int *, const int *,
|
|||
* http://www.netlib.org/lapack/explore-html/db/da9/zpbtrf_8f.html
|
||||
* */
|
||||
void RELAPACK_zpbtrf(
|
||||
const char *uplo, const int *n, const int *kd,
|
||||
double *Ab, const int *ldAb,
|
||||
int *info
|
||||
const char *uplo, const blasint *n, const blasint *kd,
|
||||
double *Ab, const blasint *ldAb,
|
||||
blasint *info
|
||||
) {
|
||||
|
||||
// Check arguments
|
||||
const int lower = LAPACK(lsame)(uplo, "L");
|
||||
const int upper = LAPACK(lsame)(uplo, "U");
|
||||
const blasint lower = LAPACK(lsame)(uplo, "L");
|
||||
const blasint upper = LAPACK(lsame)(uplo, "U");
|
||||
*info = 0;
|
||||
if (!lower && !upper)
|
||||
*info = -1;
|
||||
|
|
@ -30,8 +30,8 @@ void RELAPACK_zpbtrf(
|
|||
else if (*ldAb < *kd + 1)
|
||||
*info = -5;
|
||||
if (*info) {
|
||||
const int minfo = -*info;
|
||||
LAPACK(xerbla)("ZPBTRF", &minfo);
|
||||
const blasint minfo = -*info;
|
||||
LAPACK(xerbla)("ZPBTRF", &minfo, strlen("ZPBTRF"));
|
||||
return;
|
||||
}
|
||||
|
||||
|
|
@ -42,9 +42,9 @@ void RELAPACK_zpbtrf(
|
|||
const double ZERO[] = { 0., 0. };
|
||||
|
||||
// Allocate work space
|
||||
const int n1 = ZREC_SPLIT(*n);
|
||||
const int mWork = (*kd > n1) ? (lower ? *n - *kd : n1) : *kd;
|
||||
const int nWork = (*kd > n1) ? (lower ? n1 : *n - *kd) : *kd;
|
||||
const blasint n1 = ZREC_SPLIT(*n);
|
||||
const blasint mWork = (*kd > n1) ? (lower ? *n - *kd : n1) : *kd;
|
||||
const blasint nWork = (*kd > n1) ? (lower ? n1 : *n - *kd) : *kd;
|
||||
double *Work = malloc(mWork * nWork * 2 * sizeof(double));
|
||||
LAPACK(zlaset)(uplo, &mWork, &nWork, ZERO, ZERO, Work, &mWork);
|
||||
|
||||
|
|
@ -58,10 +58,10 @@ void RELAPACK_zpbtrf(
|
|||
|
||||
/** zpbtrf's recursive compute kernel */
|
||||
static void RELAPACK_zpbtrf_rec(
|
||||
const char *uplo, const int *n, const int *kd,
|
||||
double *Ab, const int *ldAb,
|
||||
double *Work, const int *ldWork,
|
||||
int *info
|
||||
const char *uplo, const blasint *n, const blasint *kd,
|
||||
double *Ab, const blasint *ldAb,
|
||||
double *Work, const blasint *ldWork,
|
||||
blasint *info
|
||||
){
|
||||
|
||||
if (*n <= MAX(CROSSOVER_ZPBTRF, 1)) {
|
||||
|
|
@ -75,12 +75,12 @@ static void RELAPACK_zpbtrf_rec(
|
|||
const double MONE[] = { -1., 0. };
|
||||
|
||||
// Unskew A
|
||||
const int ldA[] = { *ldAb - 1 };
|
||||
const blasint ldA[] = { *ldAb - 1 };
|
||||
double *const A = Ab + 2 * ((*uplo == 'L') ? 0 : *kd);
|
||||
|
||||
// Splitting
|
||||
const int n1 = MIN(ZREC_SPLIT(*n), *kd);
|
||||
const int n2 = *n - n1;
|
||||
const blasint n1 = MIN(ZREC_SPLIT(*n), *kd);
|
||||
const blasint n2 = *n - n1;
|
||||
|
||||
// * *
|
||||
// * Ab_BR
|
||||
|
|
@ -99,8 +99,8 @@ static void RELAPACK_zpbtrf_rec(
|
|||
return;
|
||||
|
||||
// Banded splitting
|
||||
const int n21 = MIN(n2, *kd - n1);
|
||||
const int n22 = MIN(n2 - n21, *kd);
|
||||
const blasint n21 = MIN(n2, *kd - n1);
|
||||
const blasint n22 = MIN(n2 - n21, *kd);
|
||||
|
||||
// n1 n21 n22
|
||||
// n1 * A_TRl A_TRr
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
#include "relapack.h"
|
||||
|
||||
static void RELAPACK_zpotrf_rec(const char *, const int *, double *,
|
||||
const int *, int *);
|
||||
static void RELAPACK_zpotrf_rec(const char *, const blasint *, double *,
|
||||
const blasint *, blasint *);
|
||||
|
||||
|
||||
/** ZPOTRF computes the Cholesky factorization of a complex Hermitian positive definite matrix A.
|
||||
|
|
@ -11,14 +11,14 @@ static void RELAPACK_zpotrf_rec(const char *, const int *, double *,
|
|||
* http://www.netlib.org/lapack/explore-html/d1/db9/zpotrf_8f.html
|
||||
* */
|
||||
void RELAPACK_zpotrf(
|
||||
const char *uplo, const int *n,
|
||||
double *A, const int *ldA,
|
||||
int *info
|
||||
const char *uplo, const blasint *n,
|
||||
double *A, const blasint *ldA,
|
||||
blasint *info
|
||||
) {
|
||||
|
||||
// Check arguments
|
||||
const int lower = LAPACK(lsame)(uplo, "L");
|
||||
const int upper = LAPACK(lsame)(uplo, "U");
|
||||
const blasint lower = LAPACK(lsame)(uplo, "L");
|
||||
const blasint upper = LAPACK(lsame)(uplo, "U");
|
||||
*info = 0;
|
||||
if (!lower && !upper)
|
||||
*info = -1;
|
||||
|
|
@ -27,8 +27,8 @@ void RELAPACK_zpotrf(
|
|||
else if (*ldA < MAX(1, *n))
|
||||
*info = -4;
|
||||
if (*info) {
|
||||
const int minfo = -*info;
|
||||
LAPACK(xerbla)("ZPOTRF", &minfo);
|
||||
const blasint minfo = -*info;
|
||||
LAPACK(xerbla)("ZPOTRF", &minfo, strlen("ZPOTRF"));
|
||||
return;
|
||||
}
|
||||
|
||||
|
|
@ -42,9 +42,9 @@ void RELAPACK_zpotrf(
|
|||
|
||||
/** zpotrf's recursive compute kernel */
|
||||
static void RELAPACK_zpotrf_rec(
|
||||
const char *uplo, const int *n,
|
||||
double *A, const int *ldA,
|
||||
int *info
|
||||
const char *uplo, const blasint *n,
|
||||
double *A, const blasint *ldA,
|
||||
blasint *info
|
||||
) {
|
||||
|
||||
if (*n <= MAX(CROSSOVER_ZPOTRF, 1)) {
|
||||
|
|
@ -58,8 +58,8 @@ static void RELAPACK_zpotrf_rec(
|
|||
const double MONE[] = { -1., 0. };
|
||||
|
||||
// Splitting
|
||||
const int n1 = ZREC_SPLIT(*n);
|
||||
const int n2 = *n - n1;
|
||||
const blasint n1 = ZREC_SPLIT(*n);
|
||||
const blasint n2 = *n - n1;
|
||||
|
||||
// A_TL A_TR
|
||||
// A_BL A_BR
|
||||
|
|
|
|||
|
|
@ -3,8 +3,8 @@
|
|||
#include <stdlib.h>
|
||||
#endif
|
||||
|
||||
static void RELAPACK_zsytrf_rec(const char *, const int *, const int *, int *,
|
||||
double *, const int *, int *, double *, const int *, int *);
|
||||
static void RELAPACK_zsytrf_rec(const char *, const blasint *, const blasint *, blasint *,
|
||||
double *, const blasint *, blasint *, double *, const blasint *, blasint *);
|
||||
|
||||
|
||||
/** ZSYTRF computes the factorization of a complex symmetric matrix A using the Bunch-Kaufman diagonal pivoting method.
|
||||
|
|
@ -14,21 +14,21 @@ static void RELAPACK_zsytrf_rec(const char *, const int *, const int *, int *,
|
|||
* http://www.netlib.org/lapack/explore-html/da/d94/zsytrf_8f.html
|
||||
* */
|
||||
void RELAPACK_zsytrf(
|
||||
const char *uplo, const int *n,
|
||||
double *A, const int *ldA, int *ipiv,
|
||||
double *Work, const int *lWork, int *info
|
||||
const char *uplo, const blasint *n,
|
||||
double *A, const blasint *ldA, blasint *ipiv,
|
||||
double *Work, const blasint *lWork, blasint *info
|
||||
) {
|
||||
|
||||
// Required work size
|
||||
const int cleanlWork = *n * (*n / 2);
|
||||
int minlWork = cleanlWork;
|
||||
const blasint cleanlWork = *n * (*n / 2);
|
||||
blasint minlWork = cleanlWork;
|
||||
#if XSYTRF_ALLOW_MALLOC
|
||||
minlWork = 1;
|
||||
#endif
|
||||
|
||||
// Check arguments
|
||||
const int lower = LAPACK(lsame)(uplo, "L");
|
||||
const int upper = LAPACK(lsame)(uplo, "U");
|
||||
const blasint lower = LAPACK(lsame)(uplo, "L");
|
||||
const blasint upper = LAPACK(lsame)(uplo, "U");
|
||||
*info = 0;
|
||||
if (!lower && !upper)
|
||||
*info = -1;
|
||||
|
|
@ -55,8 +55,8 @@ void RELAPACK_zsytrf(
|
|||
#endif
|
||||
|
||||
if (*info) {
|
||||
const int minfo = -*info;
|
||||
LAPACK(xerbla)("ZSYTRF", &minfo);
|
||||
const blasint minfo = -*info;
|
||||
LAPACK(xerbla)("ZSYTRF", &minfo, strlen("ZSYTRF"));
|
||||
return;
|
||||
}
|
||||
|
||||
|
|
@ -64,7 +64,7 @@ void RELAPACK_zsytrf(
|
|||
const char cleanuplo = lower ? 'L' : 'U';
|
||||
|
||||
// Dummy arguments
|
||||
int nout;
|
||||
blasint nout;
|
||||
|
||||
// Recursive kernel
|
||||
RELAPACK_zsytrf_rec(&cleanuplo, n, n, &nout, A, ldA, ipiv, cleanWork, n, info);
|
||||
|
|
@ -78,13 +78,13 @@ void RELAPACK_zsytrf(
|
|||
|
||||
/** zsytrf's recursive compute kernel */
|
||||
static void RELAPACK_zsytrf_rec(
|
||||
const char *uplo, const int *n_full, const int *n, int *n_out,
|
||||
double *A, const int *ldA, int *ipiv,
|
||||
double *Work, const int *ldWork, int *info
|
||||
const char *uplo, const blasint *n_full, const blasint *n, blasint *n_out,
|
||||
double *A, const blasint *ldA, blasint *ipiv,
|
||||
double *Work, const blasint *ldWork, blasint *info
|
||||
) {
|
||||
|
||||
// top recursion level?
|
||||
const int top = *n_full == *n;
|
||||
const blasint top = *n_full == *n;
|
||||
|
||||
if (*n <= MAX(CROSSOVER_ZSYTRF, 3)) {
|
||||
// Unblocked
|
||||
|
|
@ -96,34 +96,34 @@ static void RELAPACK_zsytrf_rec(
|
|||
return;
|
||||
}
|
||||
|
||||
int info1, info2;
|
||||
blasint info1, info2;
|
||||
|
||||
// Constants
|
||||
const double ONE[] = { 1., 0. };
|
||||
const double MONE[] = { -1., 0. };
|
||||
const int iONE[] = { 1 };
|
||||
const blasint iONE[] = { 1 };
|
||||
|
||||
// Loop iterator
|
||||
int i;
|
||||
blasint i;
|
||||
|
||||
const int n_rest = *n_full - *n;
|
||||
const blasint n_rest = *n_full - *n;
|
||||
|
||||
if (*uplo == 'L') {
|
||||
// Splitting (setup)
|
||||
int n1 = ZREC_SPLIT(*n);
|
||||
int n2 = *n - n1;
|
||||
blasint n1 = ZREC_SPLIT(*n);
|
||||
blasint n2 = *n - n1;
|
||||
|
||||
// Work_L *
|
||||
double *const Work_L = Work;
|
||||
|
||||
// recursion(A_L)
|
||||
int n1_out;
|
||||
blasint n1_out;
|
||||
RELAPACK_zsytrf_rec(uplo, n_full, &n1, &n1_out, A, ldA, ipiv, Work_L, ldWork, &info1);
|
||||
n1 = n1_out;
|
||||
|
||||
// Splitting (continued)
|
||||
n2 = *n - n1;
|
||||
const int n_full2 = *n_full - n1;
|
||||
const blasint n_full2 = *n_full - n1;
|
||||
|
||||
// * *
|
||||
// A_BL A_BR
|
||||
|
|
@ -139,23 +139,23 @@ static void RELAPACK_zsytrf_rec(
|
|||
// (top recursion level: use Work as Work_BR)
|
||||
double *const Work_BL = Work + 2 * n1;
|
||||
double *const Work_BR = top ? Work : Work + 2 * *ldWork * n1 + 2 * n1;
|
||||
const int ldWork_BR = top ? n2 : *ldWork;
|
||||
const blasint ldWork_BR = top ? n2 : *ldWork;
|
||||
|
||||
// ipiv_T
|
||||
// ipiv_B
|
||||
int *const ipiv_B = ipiv + n1;
|
||||
blasint *const ipiv_B = ipiv + n1;
|
||||
|
||||
// A_BR = A_BR - A_BL Work_BL'
|
||||
RELAPACK_zgemmt(uplo, "N", "T", &n2, &n1, MONE, A_BL, ldA, Work_BL, ldWork, ONE, A_BR, ldA);
|
||||
BLAS(zgemm)("N", "T", &n_rest, &n2, &n1, MONE, A_BL_B, ldA, Work_BL, ldWork, ONE, A_BR_B, ldA);
|
||||
|
||||
// recursion(A_BR)
|
||||
int n2_out;
|
||||
blasint n2_out;
|
||||
RELAPACK_zsytrf_rec(uplo, &n_full2, &n2, &n2_out, A_BR, ldA, ipiv_B, Work_BR, &ldWork_BR, &info2);
|
||||
|
||||
if (n2_out != n2) {
|
||||
// undo 1 column of updates
|
||||
const int n_restp1 = n_rest + 1;
|
||||
const blasint n_restp1 = n_rest + 1;
|
||||
|
||||
// last column of A_BR
|
||||
double *const A_BR_r = A_BR + 2 * *ldA * n2_out + 2 * n2_out;
|
||||
|
|
@ -182,22 +182,22 @@ static void RELAPACK_zsytrf_rec(
|
|||
*n_out = n1 + n2;
|
||||
} else {
|
||||
// Splitting (setup)
|
||||
int n2 = ZREC_SPLIT(*n);
|
||||
int n1 = *n - n2;
|
||||
blasint n2 = ZREC_SPLIT(*n);
|
||||
blasint n1 = *n - n2;
|
||||
|
||||
// * Work_R
|
||||
// (top recursion level: use Work as Work_R)
|
||||
double *const Work_R = top ? Work : Work + 2 * *ldWork * n1;
|
||||
|
||||
// recursion(A_R)
|
||||
int n2_out;
|
||||
blasint n2_out;
|
||||
RELAPACK_zsytrf_rec(uplo, n_full, &n2, &n2_out, A, ldA, ipiv, Work_R, ldWork, &info2);
|
||||
const int n2_diff = n2 - n2_out;
|
||||
const blasint n2_diff = n2 - n2_out;
|
||||
n2 = n2_out;
|
||||
|
||||
// Splitting (continued)
|
||||
n1 = *n - n2;
|
||||
const int n_full1 = *n_full - n2;
|
||||
const blasint n_full1 = *n_full - n2;
|
||||
|
||||
// * A_TL_T A_TR_T
|
||||
// * A_TL A_TR
|
||||
|
|
@ -213,19 +213,19 @@ static void RELAPACK_zsytrf_rec(
|
|||
// (top recursion level: Work_R was Work)
|
||||
double *const Work_L = Work;
|
||||
double *const Work_TR = Work + 2 * *ldWork * (top ? n2_diff : n1) + 2 * n_rest;
|
||||
const int ldWork_L = top ? n1 : *ldWork;
|
||||
const blasint ldWork_L = top ? n1 : *ldWork;
|
||||
|
||||
// A_TL = A_TL - A_TR Work_TR'
|
||||
RELAPACK_zgemmt(uplo, "N", "T", &n1, &n2, MONE, A_TR, ldA, Work_TR, ldWork, ONE, A_TL, ldA);
|
||||
BLAS(zgemm)("N", "T", &n_rest, &n1, &n2, MONE, A_TR_T, ldA, Work_TR, ldWork, ONE, A_TL_T, ldA);
|
||||
|
||||
// recursion(A_TL)
|
||||
int n1_out;
|
||||
blasint n1_out;
|
||||
RELAPACK_zsytrf_rec(uplo, &n_full1, &n1, &n1_out, A, ldA, ipiv, Work_L, &ldWork_L, &info1);
|
||||
|
||||
if (n1_out != n1) {
|
||||
// undo 1 column of updates
|
||||
const int n_restp1 = n_rest + 1;
|
||||
const blasint n_restp1 = n_rest + 1;
|
||||
|
||||
// A_TL_T_l = A_TL_T_l + A_TR_T Work_TR_t'
|
||||
BLAS(zgemv)("N", &n_restp1, &n2, ONE, A_TR_T, ldA, Work_TR, ldWork, ONE, A_TL_T, iONE);
|
||||
|
|
|
|||
|
|
@ -15,7 +15,7 @@
|
|||
/* Table of constant values */
|
||||
|
||||
static doublecomplex c_b1 = {1.,0.};
|
||||
static int c__1 = 1;
|
||||
static blasint c__1 = 1;
|
||||
|
||||
/** ZSYTRF_REC2 computes a partial factorization of a complex symmetric matrix using the Bunch-Kaufman diagon al pivoting method.
|
||||
*
|
||||
|
|
@ -24,12 +24,12 @@ static int c__1 = 1;
|
|||
* The blocked BLAS Level 3 updates were removed and moved to the
|
||||
* recursive algorithm.
|
||||
* */
|
||||
/* Subroutine */ void RELAPACK_zsytrf_rec2(char *uplo, int *n, int *
|
||||
nb, int *kb, doublecomplex *a, int *lda, int *ipiv,
|
||||
doublecomplex *w, int *ldw, int *info, ftnlen uplo_len)
|
||||
/* Subroutine */ void RELAPACK_zsytrf_rec2(char *uplo, blasint *n, blasint *
|
||||
nb, blasint *kb, doublecomplex *a, blasint *lda, blasint *ipiv,
|
||||
doublecomplex *w, blasint *ldw, blasint *info, ftnlen uplo_len)
|
||||
{
|
||||
/* System generated locals */
|
||||
int a_dim1, a_offset, w_dim1, w_offset, i__1, i__2, i__3, i__4;
|
||||
blasint a_dim1, a_offset, w_dim1, w_offset, i__1, i__2, i__3, i__4;
|
||||
double d__1, d__2, d__3, d__4;
|
||||
doublecomplex z__1, z__2, z__3;
|
||||
|
||||
|
|
@ -38,22 +38,22 @@ static int c__1 = 1;
|
|||
void z_div(doublecomplex *, doublecomplex *, doublecomplex *);
|
||||
|
||||
/* Local variables */
|
||||
static int j, k;
|
||||
static blasint j, k;
|
||||
static doublecomplex t, r1, d11, d21, d22;
|
||||
static int jj, kk, jp, kp, kw, kkw, imax, jmax;
|
||||
static blasint jj, kk, jp, kp, kw, kkw, imax, jmax;
|
||||
static double alpha;
|
||||
extern logical lsame_(char *, char *, ftnlen, ftnlen);
|
||||
extern /* Subroutine */ int zscal_(int *, doublecomplex *,
|
||||
doublecomplex *, int *);
|
||||
static int kstep;
|
||||
extern /* Subroutine */ int zgemv_(char *, int *, int *,
|
||||
doublecomplex *, doublecomplex *, int *, doublecomplex *,
|
||||
int *, doublecomplex *, doublecomplex *, int *, ftnlen),
|
||||
zcopy_(int *, doublecomplex *, int *, doublecomplex *,
|
||||
int *), zswap_(int *, doublecomplex *, int *,
|
||||
doublecomplex *, int *);
|
||||
extern /* Subroutine */ blasint zscal_(int *, doublecomplex *,
|
||||
doublecomplex *, blasint *);
|
||||
static blasint kstep;
|
||||
extern /* Subroutine */ blasint zgemv_(char *, blasint *, blasint *,
|
||||
doublecomplex *, doublecomplex *, blasint *, doublecomplex *,
|
||||
blasint *, doublecomplex *, doublecomplex *, blasint *, ftnlen),
|
||||
zcopy_(int *, doublecomplex *, blasint *, doublecomplex *,
|
||||
blasint *), zswap_(int *, doublecomplex *, blasint *,
|
||||
doublecomplex *, blasint *);
|
||||
static double absakk, colmax;
|
||||
extern int izamax_(int *, doublecomplex *, int *);
|
||||
extern blasint izamax_(int *, doublecomplex *, blasint *);
|
||||
static double rowmax;
|
||||
|
||||
/* Parameter adjustments */
|
||||
|
|
|
|||
|
|
@ -3,8 +3,8 @@
|
|||
#include <stdlib.h>
|
||||
#endif
|
||||
|
||||
static void RELAPACK_zsytrf_rook_rec(const char *, const int *, const int *, int *,
|
||||
double *, const int *, int *, double *, const int *, int *);
|
||||
static void RELAPACK_zsytrf_rook_rec(const char *, const blasint *, const blasint *, blasint *,
|
||||
double *, const blasint *, blasint *, double *, const blasint *, blasint *);
|
||||
|
||||
|
||||
/** ZSYTRF_ROOK computes the factorization of a complex symmetric matrix A using the bounded Bunch-Kaufman ("rook") diagonal pivoting method.
|
||||
|
|
@ -14,21 +14,21 @@ static void RELAPACK_zsytrf_rook_rec(const char *, const int *, const int *, int
|
|||
* http://www.netlib.org/lapack/explore-html/d6/d6e/zsytrf__rook_8f.html
|
||||
* */
|
||||
void RELAPACK_zsytrf_rook(
|
||||
const char *uplo, const int *n,
|
||||
double *A, const int *ldA, int *ipiv,
|
||||
double *Work, const int *lWork, int *info
|
||||
const char *uplo, const blasint *n,
|
||||
double *A, const blasint *ldA, blasint *ipiv,
|
||||
double *Work, const blasint *lWork, blasint *info
|
||||
) {
|
||||
|
||||
// Required work size
|
||||
const int cleanlWork = *n * (*n / 2);
|
||||
int minlWork = cleanlWork;
|
||||
const blasint cleanlWork = *n * (*n / 2);
|
||||
blasint minlWork = cleanlWork;
|
||||
#if XSYTRF_ALLOW_MALLOC
|
||||
minlWork = 1;
|
||||
#endif
|
||||
|
||||
// Check arguments
|
||||
const int lower = LAPACK(lsame)(uplo, "L");
|
||||
const int upper = LAPACK(lsame)(uplo, "U");
|
||||
const blasint lower = LAPACK(lsame)(uplo, "L");
|
||||
const blasint upper = LAPACK(lsame)(uplo, "U");
|
||||
*info = 0;
|
||||
if (!lower && !upper)
|
||||
*info = -1;
|
||||
|
|
@ -55,8 +55,8 @@ void RELAPACK_zsytrf_rook(
|
|||
#endif
|
||||
|
||||
if (*info) {
|
||||
const int minfo = -*info;
|
||||
LAPACK(xerbla)("ZSYTRF", &minfo);
|
||||
const blasint minfo = -*info;
|
||||
LAPACK(xerbla)("ZSYTRF", &minfo, strlen("ZSYTRF"));
|
||||
return;
|
||||
}
|
||||
|
||||
|
|
@ -64,7 +64,7 @@ void RELAPACK_zsytrf_rook(
|
|||
const char cleanuplo = lower ? 'L' : 'U';
|
||||
|
||||
// Dummy argument
|
||||
int nout;
|
||||
blasint nout;
|
||||
|
||||
// Recursive kernel
|
||||
RELAPACK_zsytrf_rook_rec(&cleanuplo, n, n, &nout, A, ldA, ipiv, cleanWork, n, info);
|
||||
|
|
@ -78,13 +78,13 @@ void RELAPACK_zsytrf_rook(
|
|||
|
||||
/** zsytrf_rook's recursive compute kernel */
|
||||
static void RELAPACK_zsytrf_rook_rec(
|
||||
const char *uplo, const int *n_full, const int *n, int *n_out,
|
||||
double *A, const int *ldA, int *ipiv,
|
||||
double *Work, const int *ldWork, int *info
|
||||
const char *uplo, const blasint *n_full, const blasint *n, blasint *n_out,
|
||||
double *A, const blasint *ldA, blasint *ipiv,
|
||||
double *Work, const blasint *ldWork, blasint *info
|
||||
) {
|
||||
|
||||
// top recursion level?
|
||||
const int top = *n_full == *n;
|
||||
const blasint top = *n_full == *n;
|
||||
|
||||
if (*n <= MAX(CROSSOVER_ZSYTRF_ROOK, 3)) {
|
||||
// Unblocked
|
||||
|
|
@ -96,31 +96,31 @@ static void RELAPACK_zsytrf_rook_rec(
|
|||
return;
|
||||
}
|
||||
|
||||
int info1, info2;
|
||||
blasint info1, info2;
|
||||
|
||||
// Constants
|
||||
const double ONE[] = { 1., 0. };
|
||||
const double MONE[] = { -1., 0. };
|
||||
const int iONE[] = { 1 };
|
||||
const blasint iONE[] = { 1 };
|
||||
|
||||
const int n_rest = *n_full - *n;
|
||||
const blasint n_rest = *n_full - *n;
|
||||
|
||||
if (*uplo == 'L') {
|
||||
// Splitting (setup)
|
||||
int n1 = ZREC_SPLIT(*n);
|
||||
int n2 = *n - n1;
|
||||
blasint n1 = ZREC_SPLIT(*n);
|
||||
blasint n2 = *n - n1;
|
||||
|
||||
// Work_L *
|
||||
double *const Work_L = Work;
|
||||
|
||||
// recursion(A_L)
|
||||
int n1_out;
|
||||
blasint n1_out;
|
||||
RELAPACK_zsytrf_rook_rec(uplo, n_full, &n1, &n1_out, A, ldA, ipiv, Work_L, ldWork, &info1);
|
||||
n1 = n1_out;
|
||||
|
||||
// Splitting (continued)
|
||||
n2 = *n - n1;
|
||||
const int n_full2 = *n_full - n1;
|
||||
const blasint n_full2 = *n_full - n1;
|
||||
|
||||
// * *
|
||||
// A_BL A_BR
|
||||
|
|
@ -136,23 +136,23 @@ static void RELAPACK_zsytrf_rook_rec(
|
|||
// (top recursion level: use Work as Work_BR)
|
||||
double *const Work_BL = Work + 2 * n1;
|
||||
double *const Work_BR = top ? Work : Work + 2 * *ldWork * n1 + 2 * n1;
|
||||
const int ldWork_BR = top ? n2 : *ldWork;
|
||||
const blasint ldWork_BR = top ? n2 : *ldWork;
|
||||
|
||||
// ipiv_T
|
||||
// ipiv_B
|
||||
int *const ipiv_B = ipiv + n1;
|
||||
blasint *const ipiv_B = ipiv + n1;
|
||||
|
||||
// A_BR = A_BR - A_BL Work_BL'
|
||||
RELAPACK_zgemmt(uplo, "N", "T", &n2, &n1, MONE, A_BL, ldA, Work_BL, ldWork, ONE, A_BR, ldA);
|
||||
BLAS(zgemm)("N", "T", &n_rest, &n2, &n1, MONE, A_BL_B, ldA, Work_BL, ldWork, ONE, A_BR_B, ldA);
|
||||
|
||||
// recursion(A_BR)
|
||||
int n2_out;
|
||||
blasint n2_out;
|
||||
RELAPACK_zsytrf_rook_rec(uplo, &n_full2, &n2, &n2_out, A_BR, ldA, ipiv_B, Work_BR, &ldWork_BR, &info2);
|
||||
|
||||
if (n2_out != n2) {
|
||||
// undo 1 column of updates
|
||||
const int n_restp1 = n_rest + 1;
|
||||
const blasint n_restp1 = n_rest + 1;
|
||||
|
||||
// last column of A_BR
|
||||
double *const A_BR_r = A_BR + 2 * *ldA * n2_out + 2 * n2_out;
|
||||
|
|
@ -169,7 +169,7 @@ static void RELAPACK_zsytrf_rook_rec(
|
|||
n2 = n2_out;
|
||||
|
||||
// shift pivots
|
||||
int i;
|
||||
blasint i;
|
||||
for (i = 0; i < n2; i++)
|
||||
if (ipiv_B[i] > 0)
|
||||
ipiv_B[i] += n1;
|
||||
|
|
@ -180,22 +180,22 @@ static void RELAPACK_zsytrf_rook_rec(
|
|||
*n_out = n1 + n2;
|
||||
} else {
|
||||
// Splitting (setup)
|
||||
int n2 = ZREC_SPLIT(*n);
|
||||
int n1 = *n - n2;
|
||||
blasint n2 = ZREC_SPLIT(*n);
|
||||
blasint n1 = *n - n2;
|
||||
|
||||
// * Work_R
|
||||
// (top recursion level: use Work as Work_R)
|
||||
double *const Work_R = top ? Work : Work + 2 * *ldWork * n1;
|
||||
|
||||
// recursion(A_R)
|
||||
int n2_out;
|
||||
blasint n2_out;
|
||||
RELAPACK_zsytrf_rook_rec(uplo, n_full, &n2, &n2_out, A, ldA, ipiv, Work_R, ldWork, &info2);
|
||||
const int n2_diff = n2 - n2_out;
|
||||
const blasint n2_diff = n2 - n2_out;
|
||||
n2 = n2_out;
|
||||
|
||||
// Splitting (continued)
|
||||
n1 = *n - n2;
|
||||
const int n_full1 = *n_full - n2;
|
||||
const blasint n_full1 = *n_full - n2;
|
||||
|
||||
// * A_TL_T A_TR_T
|
||||
// * A_TL A_TR
|
||||
|
|
@ -211,19 +211,19 @@ static void RELAPACK_zsytrf_rook_rec(
|
|||
// (top recursion level: Work_R was Work)
|
||||
double *const Work_L = Work;
|
||||
double *const Work_TR = Work + 2 * *ldWork * (top ? n2_diff : n1) + 2 * n_rest;
|
||||
const int ldWork_L = top ? n1 : *ldWork;
|
||||
const blasint ldWork_L = top ? n1 : *ldWork;
|
||||
|
||||
// A_TL = A_TL - A_TR Work_TR'
|
||||
RELAPACK_zgemmt(uplo, "N", "T", &n1, &n2, MONE, A_TR, ldA, Work_TR, ldWork, ONE, A_TL, ldA);
|
||||
BLAS(zgemm)("N", "T", &n_rest, &n1, &n2, MONE, A_TR_T, ldA, Work_TR, ldWork, ONE, A_TL_T, ldA);
|
||||
|
||||
// recursion(A_TL)
|
||||
int n1_out;
|
||||
blasint n1_out;
|
||||
RELAPACK_zsytrf_rook_rec(uplo, &n_full1, &n1, &n1_out, A, ldA, ipiv, Work_L, &ldWork_L, &info1);
|
||||
|
||||
if (n1_out != n1) {
|
||||
// undo 1 column of updates
|
||||
const int n_restp1 = n_rest + 1;
|
||||
const blasint n_restp1 = n_rest + 1;
|
||||
|
||||
// A_TL_T_l = A_TL_T_l + A_TR_T Work_TR_t'
|
||||
BLAS(zgemv)("N", &n_restp1, &n2, ONE, A_TR_T, ldA, Work_TR, ldWork, ONE, A_TL_T, iONE);
|
||||
|
|
|
|||
|
|
@ -15,7 +15,7 @@
|
|||
/* Table of constant values */
|
||||
|
||||
static doublecomplex c_b1 = {1.,0.};
|
||||
static int c__1 = 1;
|
||||
static blasint c__1 = 1;
|
||||
|
||||
/** ZSYTRF_ROOK_REC2 computes a partial factorization of a complex symmetric matrix using the bounded Bunch-K aufman ("rook") diagonal pivoting method.
|
||||
*
|
||||
|
|
@ -24,12 +24,12 @@ static int c__1 = 1;
|
|||
* The blocked BLAS Level 3 updates were removed and moved to the
|
||||
* recursive algorithm.
|
||||
* */
|
||||
/* Subroutine */ void RELAPACK_zsytrf_rook_rec2(char *uplo, int *n,
|
||||
int *nb, int *kb, doublecomplex *a, int *lda, int *
|
||||
ipiv, doublecomplex *w, int *ldw, int *info, ftnlen uplo_len)
|
||||
/* Subroutine */ void RELAPACK_zsytrf_rook_rec2(char *uplo, blasint *n,
|
||||
int *nb, blasint *kb, doublecomplex *a, blasint *lda, blasint *
|
||||
ipiv, doublecomplex *w, blasint *ldw, blasint *info, ftnlen uplo_len)
|
||||
{
|
||||
/* System generated locals */
|
||||
int a_dim1, a_offset, w_dim1, w_offset, i__1, i__2, i__3, i__4;
|
||||
blasint a_dim1, a_offset, w_dim1, w_offset, i__1, i__2, i__3, i__4;
|
||||
double d__1, d__2;
|
||||
doublecomplex z__1, z__2, z__3, z__4;
|
||||
|
||||
|
|
@ -38,26 +38,26 @@ static int c__1 = 1;
|
|||
void z_div(doublecomplex *, doublecomplex *, doublecomplex *);
|
||||
|
||||
/* Local variables */
|
||||
static int j, k, p;
|
||||
static blasint j, k, p;
|
||||
static doublecomplex t, r1, d11, d12, d21, d22;
|
||||
static int ii, jj, kk, kp, kw, jp1, jp2, kkw;
|
||||
static blasint ii, jj, kk, kp, kw, jp1, jp2, kkw;
|
||||
static logical done;
|
||||
static int imax, jmax;
|
||||
static blasint imax, jmax;
|
||||
static double alpha;
|
||||
extern logical lsame_(char *, char *, ftnlen, ftnlen);
|
||||
static double dtemp, sfmin;
|
||||
extern /* Subroutine */ int zscal_(int *, doublecomplex *,
|
||||
doublecomplex *, int *);
|
||||
static int itemp, kstep;
|
||||
extern /* Subroutine */ int zgemv_(char *, int *, int *,
|
||||
doublecomplex *, doublecomplex *, int *, doublecomplex *,
|
||||
int *, doublecomplex *, doublecomplex *, int *, ftnlen),
|
||||
zcopy_(int *, doublecomplex *, int *, doublecomplex *,
|
||||
int *), zswap_(int *, doublecomplex *, int *,
|
||||
doublecomplex *, int *);
|
||||
extern /* Subroutine */ blasint zscal_(int *, doublecomplex *,
|
||||
doublecomplex *, blasint *);
|
||||
static blasint itemp, kstep;
|
||||
extern /* Subroutine */ blasint zgemv_(char *, blasint *, blasint *,
|
||||
doublecomplex *, doublecomplex *, blasint *, doublecomplex *,
|
||||
blasint *, doublecomplex *, doublecomplex *, blasint *, ftnlen),
|
||||
zcopy_(int *, doublecomplex *, blasint *, doublecomplex *,
|
||||
blasint *), zswap_(int *, doublecomplex *, blasint *,
|
||||
doublecomplex *, blasint *);
|
||||
extern double dlamch_(char *, ftnlen);
|
||||
static double absakk, colmax;
|
||||
extern int izamax_(int *, doublecomplex *, int *);
|
||||
extern blasint izamax_(int *, doublecomplex *, blasint *);
|
||||
static double rowmax;
|
||||
|
||||
/* Parameter adjustments */
|
||||
|
|
|
|||
|
|
@ -1,10 +1,10 @@
|
|||
#include "relapack.h"
|
||||
#include <math.h>
|
||||
|
||||
static void RELAPACK_ztgsyl_rec(const char *, const int *, const int *,
|
||||
const int *, const double *, const int *, const double *, const int *,
|
||||
double *, const int *, const double *, const int *, const double *,
|
||||
const int *, double *, const int *, double *, double *, double *, int *);
|
||||
static void RELAPACK_ztgsyl_rec(const char *, const blasint *, const blasint *,
|
||||
const blasint *, const double *, const blasint *, const double *, const blasint *,
|
||||
double *, const blasint *, const double *, const blasint *, const double *,
|
||||
const blasint *, double *, const blasint *, double *, double *, double *, blasint *);
|
||||
|
||||
|
||||
/** ZTGSYL solves the generalized Sylvester equation.
|
||||
|
|
@ -14,21 +14,21 @@ static void RELAPACK_ztgsyl_rec(const char *, const int *, const int *,
|
|||
* http://www.netlib.org/lapack/explore-html/db/d68/ztgsyl_8f.html
|
||||
* */
|
||||
void RELAPACK_ztgsyl(
|
||||
const char *trans, const int *ijob, const int *m, const int *n,
|
||||
const double *A, const int *ldA, const double *B, const int *ldB,
|
||||
double *C, const int *ldC,
|
||||
const double *D, const int *ldD, const double *E, const int *ldE,
|
||||
double *F, const int *ldF,
|
||||
const char *trans, const blasint *ijob, const blasint *m, const blasint *n,
|
||||
const double *A, const blasint *ldA, const double *B, const blasint *ldB,
|
||||
double *C, const blasint *ldC,
|
||||
const double *D, const blasint *ldD, const double *E, const blasint *ldE,
|
||||
double *F, const blasint *ldF,
|
||||
double *scale, double *dif,
|
||||
double *Work, const int *lWork, int *iWork, int *info
|
||||
double *Work, const blasint *lWork, blasint *iWork, blasint *info
|
||||
) {
|
||||
|
||||
// Parse arguments
|
||||
const int notran = LAPACK(lsame)(trans, "N");
|
||||
const int tran = LAPACK(lsame)(trans, "C");
|
||||
const blasint notran = LAPACK(lsame)(trans, "N");
|
||||
const blasint tran = LAPACK(lsame)(trans, "C");
|
||||
|
||||
// Compute work buffer size
|
||||
int lwmin = 1;
|
||||
blasint lwmin = 1;
|
||||
if (notran && (*ijob == 1 || *ijob == 2))
|
||||
lwmin = MAX(1, 2 * *m * *n);
|
||||
*info = 0;
|
||||
|
|
@ -57,8 +57,8 @@ void RELAPACK_ztgsyl(
|
|||
else if (*lWork < lwmin && *lWork != -1)
|
||||
*info = -20;
|
||||
if (*info) {
|
||||
const int minfo = -*info;
|
||||
LAPACK(xerbla)("ZTGSYL", &minfo);
|
||||
const blasint minfo = -*info;
|
||||
LAPACK(xerbla)("ZTGSYL", &minfo, strlen("ZTGSYL"));
|
||||
return;
|
||||
}
|
||||
|
||||
|
|
@ -74,8 +74,8 @@ void RELAPACK_ztgsyl(
|
|||
// Constant
|
||||
const double ZERO[] = { 0., 0. };
|
||||
|
||||
int isolve = 1;
|
||||
int ifunc = 0;
|
||||
blasint isolve = 1;
|
||||
blasint ifunc = 0;
|
||||
if (notran) {
|
||||
if (*ijob >= 3) {
|
||||
ifunc = *ijob - 2;
|
||||
|
|
@ -86,7 +86,7 @@ void RELAPACK_ztgsyl(
|
|||
}
|
||||
|
||||
double scale2;
|
||||
int iround;
|
||||
blasint iround;
|
||||
for (iround = 1; iround <= isolve; iround++) {
|
||||
*scale = 1;
|
||||
double dscale = 0;
|
||||
|
|
@ -119,13 +119,13 @@ void RELAPACK_ztgsyl(
|
|||
|
||||
/** ztgsyl's recursive vompute kernel */
|
||||
static void RELAPACK_ztgsyl_rec(
|
||||
const char *trans, const int *ifunc, const int *m, const int *n,
|
||||
const double *A, const int *ldA, const double *B, const int *ldB,
|
||||
double *C, const int *ldC,
|
||||
const double *D, const int *ldD, const double *E, const int *ldE,
|
||||
double *F, const int *ldF,
|
||||
const char *trans, const blasint *ifunc, const blasint *m, const blasint *n,
|
||||
const double *A, const blasint *ldA, const double *B, const blasint *ldB,
|
||||
double *C, const blasint *ldC,
|
||||
const double *D, const blasint *ldD, const double *E, const blasint *ldE,
|
||||
double *F, const blasint *ldF,
|
||||
double *scale, double *dsum, double *dscale,
|
||||
int *info
|
||||
blasint *info
|
||||
) {
|
||||
|
||||
if (*m <= MAX(CROSSOVER_ZTGSYL, 1) && *n <= MAX(CROSSOVER_ZTGSYL, 1)) {
|
||||
|
|
@ -137,18 +137,18 @@ static void RELAPACK_ztgsyl_rec(
|
|||
// Constants
|
||||
const double ONE[] = { 1., 0. };
|
||||
const double MONE[] = { -1., 0. };
|
||||
const int iONE[] = { 1 };
|
||||
const blasint iONE[] = { 1 };
|
||||
|
||||
// Outputs
|
||||
double scale1[] = { 1., 0. };
|
||||
double scale2[] = { 1., 0. };
|
||||
int info1[] = { 0 };
|
||||
int info2[] = { 0 };
|
||||
blasint info1[] = { 0 };
|
||||
blasint info2[] = { 0 };
|
||||
|
||||
if (*m > *n) {
|
||||
// Splitting
|
||||
const int m1 = ZREC_SPLIT(*m);
|
||||
const int m2 = *m - m1;
|
||||
const blasint m1 = ZREC_SPLIT(*m);
|
||||
const blasint m2 = *m - m1;
|
||||
|
||||
// A_TL A_TR
|
||||
// 0 A_BR
|
||||
|
|
@ -206,8 +206,8 @@ static void RELAPACK_ztgsyl_rec(
|
|||
}
|
||||
} else {
|
||||
// Splitting
|
||||
const int n1 = ZREC_SPLIT(*n);
|
||||
const int n2 = *n - n1;
|
||||
const blasint n1 = ZREC_SPLIT(*n);
|
||||
const blasint n2 = *n - n1;
|
||||
|
||||
// B_TL B_TR
|
||||
// 0 B_BR
|
||||
|
|
|
|||
|
|
@ -1,8 +1,8 @@
|
|||
#include "relapack.h"
|
||||
|
||||
static void RELAPACK_ztrsyl_rec(const char *, const char *, const int *,
|
||||
const int *, const int *, const double *, const int *, const double *,
|
||||
const int *, double *, const int *, double *, int *);
|
||||
static void RELAPACK_ztrsyl_rec(const char *, const char *, const blasint *,
|
||||
const blasint *, const blasint *, const double *, const blasint *, const double *,
|
||||
const blasint *, double *, const blasint *, double *, blasint *);
|
||||
|
||||
|
||||
/** ZTRSYL solves the complex Sylvester matrix equation.
|
||||
|
|
@ -12,18 +12,18 @@ static void RELAPACK_ztrsyl_rec(const char *, const char *, const int *,
|
|||
* http://www.netlib.org/lapack/explore-html/d1/d36/ztrsyl_8f.html
|
||||
* */
|
||||
void RELAPACK_ztrsyl(
|
||||
const char *tranA, const char *tranB, const int *isgn,
|
||||
const int *m, const int *n,
|
||||
const double *A, const int *ldA, const double *B, const int *ldB,
|
||||
double *C, const int *ldC, double *scale,
|
||||
int *info
|
||||
const char *tranA, const char *tranB, const blasint *isgn,
|
||||
const blasint *m, const blasint *n,
|
||||
const double *A, const blasint *ldA, const double *B, const blasint *ldB,
|
||||
double *C, const blasint *ldC, double *scale,
|
||||
blasint *info
|
||||
) {
|
||||
|
||||
// Check arguments
|
||||
const int notransA = LAPACK(lsame)(tranA, "N");
|
||||
const int ctransA = LAPACK(lsame)(tranA, "C");
|
||||
const int notransB = LAPACK(lsame)(tranB, "N");
|
||||
const int ctransB = LAPACK(lsame)(tranB, "C");
|
||||
const blasint notransA = LAPACK(lsame)(tranA, "N");
|
||||
const blasint ctransA = LAPACK(lsame)(tranA, "C");
|
||||
const blasint notransB = LAPACK(lsame)(tranB, "N");
|
||||
const blasint ctransB = LAPACK(lsame)(tranB, "C");
|
||||
*info = 0;
|
||||
if (!ctransA && !notransA)
|
||||
*info = -1;
|
||||
|
|
@ -42,8 +42,8 @@ void RELAPACK_ztrsyl(
|
|||
else if (*ldC < MAX(1, *m))
|
||||
*info = -11;
|
||||
if (*info) {
|
||||
const int minfo = -*info;
|
||||
LAPACK(xerbla)("ZTRSYL", &minfo);
|
||||
const blasint minfo = -*info;
|
||||
LAPACK(xerbla)("ZTRSYL", &minfo, strlen("ZTRSYL"));
|
||||
return;
|
||||
}
|
||||
|
||||
|
|
@ -58,11 +58,11 @@ void RELAPACK_ztrsyl(
|
|||
|
||||
/** ztrsyl's recursive compute kernel */
|
||||
static void RELAPACK_ztrsyl_rec(
|
||||
const char *tranA, const char *tranB, const int *isgn,
|
||||
const int *m, const int *n,
|
||||
const double *A, const int *ldA, const double *B, const int *ldB,
|
||||
double *C, const int *ldC, double *scale,
|
||||
int *info
|
||||
const char *tranA, const char *tranB, const blasint *isgn,
|
||||
const blasint *m, const blasint *n,
|
||||
const double *A, const blasint *ldA, const double *B, const blasint *ldB,
|
||||
double *C, const blasint *ldC, double *scale,
|
||||
blasint *info
|
||||
) {
|
||||
|
||||
if (*m <= MAX(CROSSOVER_ZTRSYL, 1) && *n <= MAX(CROSSOVER_ZTRSYL, 1)) {
|
||||
|
|
@ -75,18 +75,18 @@ static void RELAPACK_ztrsyl_rec(
|
|||
const double ONE[] = { 1., 0. };
|
||||
const double MONE[] = { -1., 0. };
|
||||
const double MSGN[] = { -*isgn, 0. };
|
||||
const int iONE[] = { 1 };
|
||||
const blasint iONE[] = { 1 };
|
||||
|
||||
// Outputs
|
||||
double scale1[] = { 1., 0. };
|
||||
double scale2[] = { 1., 0. };
|
||||
int info1[] = { 0 };
|
||||
int info2[] = { 0 };
|
||||
blasint info1[] = { 0 };
|
||||
blasint info2[] = { 0 };
|
||||
|
||||
if (*m > *n) {
|
||||
// Splitting
|
||||
const int m1 = ZREC_SPLIT(*m);
|
||||
const int m2 = *m - m1;
|
||||
const blasint m1 = ZREC_SPLIT(*m);
|
||||
const blasint m2 = *m - m1;
|
||||
|
||||
// A_TL A_TR
|
||||
// 0 A_BR
|
||||
|
|
@ -122,8 +122,8 @@ static void RELAPACK_ztrsyl_rec(
|
|||
}
|
||||
} else {
|
||||
// Splitting
|
||||
const int n1 = ZREC_SPLIT(*n);
|
||||
const int n2 = *n - n1;
|
||||
const blasint n1 = ZREC_SPLIT(*n);
|
||||
const blasint n2 = *n - n1;
|
||||
|
||||
// B_TL B_TR
|
||||
// 0 B_BR
|
||||
|
|
|
|||
|
|
@ -14,16 +14,16 @@
|
|||
#include "f2c.h"
|
||||
|
||||
#if BLAS_COMPLEX_FUNCTIONS_AS_ROUTINES
|
||||
doublecomplex zdotu_fun(int *n, doublecomplex *x, int *incx, doublecomplex *y, int *incy) {
|
||||
extern void zdotu_(doublecomplex *, int *, doublecomplex *, int *, doublecomplex *, int *);
|
||||
doublecomplex zdotu_fun(int *n, doublecomplex *x, blasint *incx, doublecomplex *y, blasint *incy) {
|
||||
extern void zdotu_(doublecomplex *, blasint *, doublecomplex *, blasint *, doublecomplex *, blasint *);
|
||||
doublecomplex result;
|
||||
zdotu_(&result, n, x, incx, y, incy);
|
||||
return result;
|
||||
}
|
||||
#define zdotu_ zdotu_fun
|
||||
|
||||
doublecomplex zdotc_fun(int *n, doublecomplex *x, int *incx, doublecomplex *y, int *incy) {
|
||||
extern void zdotc_(doublecomplex *, int *, doublecomplex *, int *, doublecomplex *, int *);
|
||||
doublecomplex zdotc_fun(int *n, doublecomplex *x, blasint *incx, doublecomplex *y, blasint *incy) {
|
||||
extern void zdotc_(doublecomplex *, blasint *, doublecomplex *, blasint *, doublecomplex *, blasint *);
|
||||
doublecomplex result;
|
||||
zdotc_(&result, n, x, incx, y, incy);
|
||||
return result;
|
||||
|
|
@ -43,7 +43,7 @@ doublecomplex zladiv_fun(doublecomplex *a, doublecomplex *b) {
|
|||
|
||||
/* Table of constant values */
|
||||
|
||||
static int c__1 = 1;
|
||||
static blasint c__1 = 1;
|
||||
|
||||
/** RELAPACK_ZTRSYL_REC2 solves the complex Sylvester matrix equation (unblocked algorithm)
|
||||
*
|
||||
|
|
@ -51,12 +51,12 @@ static int c__1 = 1;
|
|||
* It serves as an unblocked kernel in the recursive algorithms.
|
||||
* */
|
||||
/* Subroutine */ void RELAPACK_ztrsyl_rec2(char *trana, char *tranb, int
|
||||
*isgn, int *m, int *n, doublecomplex *a, int *lda,
|
||||
doublecomplex *b, int *ldb, doublecomplex *c__, int *ldc,
|
||||
double *scale, int *info, ftnlen trana_len, ftnlen tranb_len)
|
||||
*isgn, blasint *m, blasint *n, doublecomplex *a, blasint *lda,
|
||||
doublecomplex *b, blasint *ldb, doublecomplex *c__, blasint *ldc,
|
||||
double *scale, blasint *info, ftnlen trana_len, ftnlen tranb_len)
|
||||
{
|
||||
/* System generated locals */
|
||||
int a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2,
|
||||
blasint a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2,
|
||||
i__3, i__4;
|
||||
double d__1, d__2;
|
||||
doublecomplex z__1, z__2, z__3, z__4;
|
||||
|
|
@ -66,7 +66,7 @@ static int c__1 = 1;
|
|||
void d_cnjg(doublecomplex *, doublecomplex *);
|
||||
|
||||
/* Local variables */
|
||||
static int j, k, l;
|
||||
static blasint j, k, l;
|
||||
static doublecomplex a11;
|
||||
static double db;
|
||||
static doublecomplex x11;
|
||||
|
|
@ -74,23 +74,23 @@ static int c__1 = 1;
|
|||
static doublecomplex vec;
|
||||
static double dum[1], eps, sgn, smin;
|
||||
static doublecomplex suml, sumr;
|
||||
extern int lsame_(char *, char *, ftnlen, ftnlen);
|
||||
extern blasint lsame_(char *, char *, ftnlen, ftnlen);
|
||||
/* Double Complex */ doublecomplex zdotc_(int *,
|
||||
doublecomplex *, int *, doublecomplex *, int *), zdotu_(
|
||||
int *, doublecomplex *, int *,
|
||||
doublecomplex *, int *);
|
||||
extern /* Subroutine */ int dlabad_(double *, double *);
|
||||
doublecomplex *, blasint *, doublecomplex *, blasint *), zdotu_(
|
||||
blasint *, doublecomplex *, blasint *,
|
||||
doublecomplex *, blasint *);
|
||||
extern /* Subroutine */ blasint dlabad_(double *, double *);
|
||||
extern double dlamch_(char *, ftnlen);
|
||||
static double scaloc;
|
||||
extern /* Subroutine */ int xerbla_(char *, int *, ftnlen);
|
||||
extern double zlange_(char *, int *, int *, doublecomplex *,
|
||||
int *, double *, ftnlen);
|
||||
extern /* Subroutine */ blasint xerbla_(char *, blasint *, ftnlen);
|
||||
extern double zlange_(char *, blasint *, blasint *, doublecomplex *,
|
||||
blasint *, double *, ftnlen);
|
||||
static double bignum;
|
||||
extern /* Subroutine */ int zdscal_(int *, double *,
|
||||
doublecomplex *, int *);
|
||||
extern /* Subroutine */ blasint zdscal_(int *, double *,
|
||||
doublecomplex *, blasint *);
|
||||
/* Double Complex */ doublecomplex zladiv_(doublecomplex *,
|
||||
doublecomplex *);
|
||||
static int notrna, notrnb;
|
||||
static blasint notrna, notrnb;
|
||||
static double smlnum;
|
||||
|
||||
/* Parameter adjustments */
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
#include "relapack.h"
|
||||
|
||||
static void RELAPACK_ztrtri_rec(const char *, const char *, const int *,
|
||||
double *, const int *, int *);
|
||||
static void RELAPACK_ztrtri_rec(const char *, const char *, const blasint *,
|
||||
double *, const blasint *, blasint *);
|
||||
|
||||
|
||||
/** CTRTRI computes the inverse of a complex upper or lower triangular matrix A.
|
||||
|
|
@ -11,16 +11,16 @@ static void RELAPACK_ztrtri_rec(const char *, const char *, const int *,
|
|||
* http://www.netlib.org/lapack/explore-html/d1/d0e/ztrtri_8f.html
|
||||
* */
|
||||
void RELAPACK_ztrtri(
|
||||
const char *uplo, const char *diag, const int *n,
|
||||
double *A, const int *ldA,
|
||||
int *info
|
||||
const char *uplo, const char *diag, const blasint *n,
|
||||
double *A, const blasint *ldA,
|
||||
blasint *info
|
||||
) {
|
||||
|
||||
// Check arguments
|
||||
const int lower = LAPACK(lsame)(uplo, "L");
|
||||
const int upper = LAPACK(lsame)(uplo, "U");
|
||||
const int nounit = LAPACK(lsame)(diag, "N");
|
||||
const int unit = LAPACK(lsame)(diag, "U");
|
||||
const blasint lower = LAPACK(lsame)(uplo, "L");
|
||||
const blasint upper = LAPACK(lsame)(uplo, "U");
|
||||
const blasint nounit = LAPACK(lsame)(diag, "N");
|
||||
const blasint unit = LAPACK(lsame)(diag, "U");
|
||||
*info = 0;
|
||||
if (!lower && !upper)
|
||||
*info = -1;
|
||||
|
|
@ -31,8 +31,8 @@ void RELAPACK_ztrtri(
|
|||
else if (*ldA < MAX(1, *n))
|
||||
*info = -5;
|
||||
if (*info) {
|
||||
const int minfo = -*info;
|
||||
LAPACK(xerbla)("ZTRTRI", &minfo);
|
||||
const blasint minfo = -*info;
|
||||
LAPACK(xerbla)("ZTRTRI", &minfo, strlen("ZTRTRI"));
|
||||
return;
|
||||
}
|
||||
|
||||
|
|
@ -42,7 +42,7 @@ void RELAPACK_ztrtri(
|
|||
|
||||
// check for singularity
|
||||
if (nounit) {
|
||||
int i;
|
||||
blasint i;
|
||||
for (i = 0; i < *n; i++)
|
||||
if (A[2 * (i + *ldA * i)] == 0 && A[2 * (i + *ldA * i) + 1] == 0) {
|
||||
*info = i;
|
||||
|
|
@ -57,9 +57,9 @@ void RELAPACK_ztrtri(
|
|||
|
||||
/** ztrtri's recursive compute kernel */
|
||||
static void RELAPACK_ztrtri_rec(
|
||||
const char *uplo, const char *diag, const int *n,
|
||||
double *A, const int *ldA,
|
||||
int *info
|
||||
const char *uplo, const char *diag, const blasint *n,
|
||||
double *A, const blasint *ldA,
|
||||
blasint *info
|
||||
){
|
||||
|
||||
if (*n <= MAX(CROSSOVER_ZTRTRI, 1)) {
|
||||
|
|
@ -73,8 +73,8 @@ static void RELAPACK_ztrtri_rec(
|
|||
const double MONE[] = { -1. };
|
||||
|
||||
// Splitting
|
||||
const int n1 = ZREC_SPLIT(*n);
|
||||
const int n2 = *n - n1;
|
||||
const blasint n1 = ZREC_SPLIT(*n);
|
||||
const blasint n2 = *n - n1;
|
||||
|
||||
// A_TL A_TR
|
||||
// A_BL A_BR
|
||||
|
|
|
|||
Loading…
Reference in New Issue