Add a BLAS3-based triangular Sylvester equation solver (Reference-LAPACK PR 651)

This commit is contained in:
Martin Kroeker 2022-11-13 23:03:31 +01:00 committed by GitHub
parent 35dac5677a
commit 4bc918a791
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
2 changed files with 171 additions and 3 deletions

View File

@ -12,6 +12,7 @@
#include <stdlib.h> #include <stdlib.h>
#include <stdarg.h> #include <stdarg.h>
#include <inttypes.h>
/* It seems all current Fortran compilers put strlen at end. /* It seems all current Fortran compilers put strlen at end.
* Some historical compilers put strlen after the str argument * Some historical compilers put strlen after the str argument
@ -80,11 +81,26 @@ extern "C" {
/*----------------------------------------------------------------------------*/ /*----------------------------------------------------------------------------*/
#ifndef lapack_int #ifndef lapack_int
#define lapack_int int #if defined(LAPACK_ILP64)
#define lapack_int int64_t
#else
#define lapack_int int32_t
#endif
#endif
/*
* Integer format string
*/
#ifndef LAPACK_IFMT
#if defined(LAPACK_ILP64)
#define LAPACK_IFMT PRId64
#else
#define LAPACK_IFMT PRId32
#endif
#endif #endif
#ifndef lapack_logical #ifndef lapack_logical
#define lapack_logical lapack_int #define lapack_logical lapack_int
#endif #endif
/* f2c, hence clapack and MacOS Accelerate, returns double instead of float /* f2c, hence clapack and MacOS Accelerate, returns double instead of float
@ -115,7 +131,7 @@ typedef lapack_logical (*LAPACK_Z_SELECT2)
( const lapack_complex_double*, const lapack_complex_double* ); ( const lapack_complex_double*, const lapack_complex_double* );
#define LAPACK_lsame_base LAPACK_GLOBAL(lsame,LSAME) #define LAPACK_lsame_base LAPACK_GLOBAL(lsame,LSAME)
lapack_logical LAPACK_lsame_base( const char* ca, const char* cb, lapack_logical LAPACK_lsame_base( const char* ca, const char* cb,
lapack_int lca, lapack_int lcb lapack_int lca, lapack_int lcb
#ifdef LAPACK_FORTRAN_STRLEN_END #ifdef LAPACK_FORTRAN_STRLEN_END
, size_t, size_t , size_t, size_t
@ -21986,6 +22002,84 @@ void LAPACK_ztrsyl_base(
#define LAPACK_ztrsyl(...) LAPACK_ztrsyl_base(__VA_ARGS__) #define LAPACK_ztrsyl(...) LAPACK_ztrsyl_base(__VA_ARGS__)
#endif #endif
#define LAPACK_ctrsyl3_base LAPACK_GLOBAL(ctrsyl3,CTRSYL3)
void LAPACK_ctrsyl3_base(
char const* trana, char const* tranb,
lapack_int const* isgn, lapack_int const* m, lapack_int const* n,
lapack_complex_float const* A, lapack_int const* lda,
lapack_complex_float const* B, lapack_int const* ldb,
lapack_complex_float* C, lapack_int const* ldc, float* scale,
float* swork, lapack_int const *ldswork,
lapack_int* info
#ifdef LAPACK_FORTRAN_STRLEN_END
, size_t, size_t
#endif
);
#ifdef LAPACK_FORTRAN_STRLEN_END
#define LAPACK_ctrsyl3(...) LAPACK_ctrsyl3_base(__VA_ARGS__, 1, 1)
#else
#define LAPACK_ctrsyl3(...) LAPACK_ctrsyl3_base(__VA_ARGS__)
#endif
#define LAPACK_dtrsyl3_base LAPACK_GLOBAL(dtrsyl3,DTRSYL3)
void LAPACK_dtrsyl3_base(
char const* trana, char const* tranb,
lapack_int const* isgn, lapack_int const* m, lapack_int const* n,
double const* A, lapack_int const* lda,
double const* B, lapack_int const* ldb,
double* C, lapack_int const* ldc, double* scale,
lapack_int* iwork, lapack_int const* liwork,
double* swork, lapack_int const *ldswork,
lapack_int* info
#ifdef LAPACK_FORTRAN_STRLEN_END
, size_t, size_t
#endif
);
#ifdef LAPACK_FORTRAN_STRLEN_END
#define LAPACK_dtrsyl3(...) LAPACK_dtrsyl3_base(__VA_ARGS__, 1, 1)
#else
#define LAPACK_dtrsyl3(...) LAPACK_dtrsyl3_base(__VA_ARGS__)
#endif
#define LAPACK_strsyl3_base LAPACK_GLOBAL(strsyl3,STRSYL3)
void LAPACK_strsyl3_base(
char const* trana, char const* tranb,
lapack_int const* isgn, lapack_int const* m, lapack_int const* n,
float const* A, lapack_int const* lda,
float const* B, lapack_int const* ldb,
float* C, lapack_int const* ldc, float* scale,
lapack_int* iwork, lapack_int const* liwork,
float* swork, lapack_int const *ldswork,
lapack_int* info
#ifdef LAPACK_FORTRAN_STRLEN_END
, size_t, size_t
#endif
);
#ifdef LAPACK_FORTRAN_STRLEN_END
#define LAPACK_strsyl3(...) LAPACK_strsyl3_base(__VA_ARGS__, 1, 1)
#else
#define LAPACK_strsyl3(...) LAPACK_strsyl3_base(__VA_ARGS__)
#endif
#define LAPACK_ztrsyl3_base LAPACK_GLOBAL(ztrsyl3,ZTRSYL3)
void LAPACK_ztrsyl3_base(
char const* trana, char const* tranb,
lapack_int const* isgn, lapack_int const* m, lapack_int const* n,
lapack_complex_double const* A, lapack_int const* lda,
lapack_complex_double const* B, lapack_int const* ldb,
lapack_complex_double* C, lapack_int const* ldc, double* scale,
double* swork, lapack_int const *ldswork,
lapack_int* info
#ifdef LAPACK_FORTRAN_STRLEN_END
, size_t, size_t
#endif
);
#ifdef LAPACK_FORTRAN_STRLEN_END
#define LAPACK_ztrsyl3(...) LAPACK_ztrsyl3_base(__VA_ARGS__, 1, 1)
#else
#define LAPACK_ztrsyl3(...) LAPACK_ztrsyl3_base(__VA_ARGS__)
#endif
#define LAPACK_ctrtri_base LAPACK_GLOBAL(ctrtri,CTRTRI) #define LAPACK_ctrtri_base LAPACK_GLOBAL(ctrtri,CTRTRI)
void LAPACK_ctrtri_base( void LAPACK_ctrtri_base(
char const* uplo, char const* diag, char const* uplo, char const* diag,

View File

@ -2313,6 +2313,19 @@ lapack_int LAPACKE_zlagge( int matrix_layout, lapack_int m, lapack_int n,
float LAPACKE_slamch( char cmach ); float LAPACKE_slamch( char cmach );
double LAPACKE_dlamch( char cmach ); double LAPACKE_dlamch( char cmach );
float LAPACKE_slangb( int matrix_layout, char norm, lapack_int n,
lapack_int kl, lapack_int ku, const float* ab,
lapack_int ldab );
double LAPACKE_dlangb( int matrix_layout, char norm, lapack_int n,
lapack_int kl, lapack_int ku, const double* ab,
lapack_int ldab );
float LAPACKE_clangb( int matrix_layout, char norm, lapack_int n,
lapack_int kl, lapack_int ku,
const lapack_complex_float* ab, lapack_int ldab );
double LAPACKE_zlangb( int matrix_layout, char norm, lapack_int n,
lapack_int kl, lapack_int ku,
const lapack_complex_double* ab, lapack_int ldab );
float LAPACKE_slange( int matrix_layout, char norm, lapack_int m, float LAPACKE_slange( int matrix_layout, char norm, lapack_int m,
lapack_int n, const float* a, lapack_int lda ); lapack_int n, const float* a, lapack_int lda );
double LAPACKE_dlange( int matrix_layout, char norm, lapack_int m, double LAPACKE_dlange( int matrix_layout, char norm, lapack_int m,
@ -4477,6 +4490,23 @@ lapack_int LAPACKE_ztrsyl( int matrix_layout, char trana, char tranb,
lapack_complex_double* c, lapack_int ldc, lapack_complex_double* c, lapack_int ldc,
double* scale ); double* scale );
lapack_int LAPACKE_strsyl3( int matrix_layout, char trana, char tranb,
lapack_int isgn, lapack_int m, lapack_int n,
const float* a, lapack_int lda, const float* b,
lapack_int ldb, float* c, lapack_int ldc,
float* scale );
lapack_int LAPACKE_dtrsyl3( int matrix_layout, char trana, char tranb,
lapack_int isgn, lapack_int m, lapack_int n,
const double* a, lapack_int lda, const double* b,
lapack_int ldb, double* c, lapack_int ldc,
double* scale );
lapack_int LAPACKE_ztrsyl3( int matrix_layout, char trana, char tranb,
lapack_int isgn, lapack_int m, lapack_int n,
const lapack_complex_double* a, lapack_int lda,
const lapack_complex_double* b, lapack_int ldb,
lapack_complex_double* c, lapack_int ldc,
double* scale );
lapack_int LAPACKE_strtri( int matrix_layout, char uplo, char diag, lapack_int n, lapack_int LAPACKE_strtri( int matrix_layout, char uplo, char diag, lapack_int n,
float* a, lapack_int lda ); float* a, lapack_int lda );
lapack_int LAPACKE_dtrtri( int matrix_layout, char uplo, char diag, lapack_int n, lapack_int LAPACKE_dtrtri( int matrix_layout, char uplo, char diag, lapack_int n,
@ -7576,6 +7606,21 @@ double LAPACKE_dlapy3_work( double x, double y, double z );
float LAPACKE_slamch_work( char cmach ); float LAPACKE_slamch_work( char cmach );
double LAPACKE_dlamch_work( char cmach ); double LAPACKE_dlamch_work( char cmach );
float LAPACKE_slangb_work( int matrix_layout, char norm, lapack_int n,
lapack_int kl, lapack_int ku, const float* ab,
lapack_int ldab, float* work );
double LAPACKE_dlangb_work( int matrix_layout, char norm, lapack_int n,
lapack_int kl, lapack_int ku, const double* ab,
lapack_int ldab, double* work );
float LAPACKE_clangb_work( int matrix_layout, char norm, lapack_int n,
lapack_int kl, lapack_int ku,
const lapack_complex_float* ab, lapack_int ldab,
float* work );
double LAPACKE_zlangb_work( int matrix_layout, char norm, lapack_int n,
lapack_int kl, lapack_int ku,
const lapack_complex_double* ab, lapack_int ldab,
double* work );
float LAPACKE_slange_work( int matrix_layout, char norm, lapack_int m, float LAPACKE_slange_work( int matrix_layout, char norm, lapack_int m,
lapack_int n, const float* a, lapack_int lda, lapack_int n, const float* a, lapack_int lda,
float* work ); float* work );
@ -10174,6 +10219,35 @@ lapack_int LAPACKE_ztrsyl_work( int matrix_layout, char trana, char tranb,
lapack_complex_double* c, lapack_int ldc, lapack_complex_double* c, lapack_int ldc,
double* scale ); double* scale );
lapack_int LAPACKE_strsyl3_work( int matrix_layout, char trana, char tranb,
lapack_int isgn, lapack_int m, lapack_int n,
const float* a, lapack_int lda,
const float* b, lapack_int ldb,
float* c, lapack_int ldc, float* scale,
lapack_int* iwork, lapack_int liwork,
float* swork, lapack_int ldswork );
lapack_int LAPACKE_dtrsyl3_work( int matrix_layout, char trana, char tranb,
lapack_int isgn, lapack_int m, lapack_int n,
const double* a, lapack_int lda,
const double* b, lapack_int ldb,
double* c, lapack_int ldc, double* scale,
lapack_int* iwork, lapack_int liwork,
double* swork, lapack_int ldswork );
lapack_int LAPACKE_ctrsyl3_work( int matrix_layout, char trana, char tranb,
lapack_int isgn, lapack_int m, lapack_int n,
const lapack_complex_float* a, lapack_int lda,
const lapack_complex_float* b, lapack_int ldb,
lapack_complex_float* c, lapack_int ldc,
float* scale, float* swork,
lapack_int ldswork );
lapack_int LAPACKE_ztrsyl3_work( int matrix_layout, char trana, char tranb,
lapack_int isgn, lapack_int m, lapack_int n,
const lapack_complex_double* a, lapack_int lda,
const lapack_complex_double* b, lapack_int ldb,
lapack_complex_double* c, lapack_int ldc,
double* scale, double* swork,
lapack_int ldswork );
lapack_int LAPACKE_strtri_work( int matrix_layout, char uplo, char diag, lapack_int LAPACKE_strtri_work( int matrix_layout, char uplo, char diag,
lapack_int n, float* a, lapack_int lda ); lapack_int n, float* a, lapack_int lda );
lapack_int LAPACKE_dtrtri_work( int matrix_layout, char uplo, char diag, lapack_int LAPACKE_dtrtri_work( int matrix_layout, char uplo, char diag,