From ad584bfedd12235fe4ce20d65037f1ab2503abbb Mon Sep 17 00:00:00 2001 From: "philippe.theveny" Date: Mon, 17 Aug 2015 21:17:37 +0000 Subject: [PATCH] Added LAPACKE wrappers for GSVD (complements r1572). --- LAPACKE/include/lapacke.h | 280 +++++++++++++++++++++++++++++++++---- LAPACKE/src/CMakeLists.txt | 18 ++- LAPACKE/src/Makefile | 16 +++ LAPACKE/src/lapacke_cggsvd3.c | 96 +++++++++++++ LAPACKE/src/lapacke_cggsvd3_work.c | 189 +++++++++++++++++++++++++ LAPACKE/src/lapacke_cggsvp3.c | 119 ++++++++++++++++ LAPACKE/src/lapacke_cggsvp3_work.c | 189 +++++++++++++++++++++++++ LAPACKE/src/lapacke_dggsvd3.c | 84 +++++++++++ LAPACKE/src/lapacke_dggsvd3_work.c | 178 +++++++++++++++++++++++ LAPACKE/src/lapacke_dggsvp3.c | 107 ++++++++++++++ LAPACKE/src/lapacke_dggsvp3_work.c | 178 +++++++++++++++++++++++ LAPACKE/src/lapacke_sggsvd3.c | 85 +++++++++++ LAPACKE/src/lapacke_sggsvd3_work.c | 179 ++++++++++++++++++++++++ LAPACKE/src/lapacke_sggsvp3.c | 107 ++++++++++++++ LAPACKE/src/lapacke_sggsvp3_work.c | 179 ++++++++++++++++++++++++ LAPACKE/src/lapacke_zggsvd3.c | 97 +++++++++++++ LAPACKE/src/lapacke_zggsvd3_work.c | 188 +++++++++++++++++++++++++ LAPACKE/src/lapacke_zggsvp3.c | 119 ++++++++++++++++ LAPACKE/src/lapacke_zggsvp3_work.c | 190 +++++++++++++++++++++++++ 19 files changed, 2567 insertions(+), 31 deletions(-) create mode 100644 LAPACKE/src/lapacke_cggsvd3.c create mode 100644 LAPACKE/src/lapacke_cggsvd3_work.c create mode 100644 LAPACKE/src/lapacke_cggsvp3.c create mode 100644 LAPACKE/src/lapacke_cggsvp3_work.c create mode 100644 LAPACKE/src/lapacke_dggsvd3.c create mode 100644 LAPACKE/src/lapacke_dggsvd3_work.c create mode 100644 LAPACKE/src/lapacke_dggsvp3.c create mode 100644 LAPACKE/src/lapacke_dggsvp3_work.c create mode 100644 LAPACKE/src/lapacke_sggsvd3.c create mode 100644 LAPACKE/src/lapacke_sggsvd3_work.c create mode 100644 LAPACKE/src/lapacke_sggsvp3.c create mode 100644 LAPACKE/src/lapacke_sggsvp3_work.c create mode 100644 LAPACKE/src/lapacke_zggsvd3.c create mode 100644 LAPACKE/src/lapacke_zggsvd3_work.c create mode 100644 LAPACKE/src/lapacke_zggsvp3.c create mode 100644 LAPACKE/src/lapacke_zggsvp3_work.c diff --git a/LAPACKE/include/lapacke.h b/LAPACKE/include/lapacke.h index c68fc4c..13d4e23 100644 --- a/LAPACKE/include/lapacke.h +++ b/LAPACKE/include/lapacke.h @@ -28,7 +28,7 @@ ****************************************************************************** * Contents: Native C interface to LAPACK * Author: Intel Corporation -* Generated November, 2011 +* Generated August, 2015 *****************************************************************************/ #ifndef _LAPACKE_H_ @@ -1476,6 +1476,40 @@ lapack_int LAPACKE_zggsvd( int matrix_layout, char jobu, char jobv, char jobq, lapack_complex_double* q, lapack_int ldq, lapack_int* iwork ); +lapack_int LAPACKE_sggsvd3( int matrix_layout, char jobu, char jobv, char jobq, + lapack_int m, lapack_int n, lapack_int p, + lapack_int* k, lapack_int* l, float* a, + lapack_int lda, float* b, lapack_int ldb, + float* alpha, float* beta, float* u, lapack_int ldu, + float* v, lapack_int ldv, float* q, lapack_int ldq, + lapack_int* iwork ); +lapack_int LAPACKE_dggsvd3( int matrix_layout, char jobu, char jobv, char jobq, + lapack_int m, lapack_int n, lapack_int p, + lapack_int* k, lapack_int* l, double* a, + lapack_int lda, double* b, lapack_int ldb, + double* alpha, double* beta, double* u, + lapack_int ldu, double* v, lapack_int ldv, double* q, + lapack_int ldq, lapack_int* iwork ); +lapack_int LAPACKE_cggsvd3( int matrix_layout, char jobu, char jobv, char jobq, + lapack_int m, lapack_int n, lapack_int p, + lapack_int* k, lapack_int* l, + lapack_complex_float* a, lapack_int lda, + lapack_complex_float* b, lapack_int ldb, + float* alpha, float* beta, lapack_complex_float* u, + lapack_int ldu, lapack_complex_float* v, + lapack_int ldv, lapack_complex_float* q, + lapack_int ldq, lapack_int* iwork ); +lapack_int LAPACKE_zggsvd3( int matrix_layout, char jobu, char jobv, char jobq, + lapack_int m, lapack_int n, lapack_int p, + lapack_int* k, lapack_int* l, + lapack_complex_double* a, lapack_int lda, + lapack_complex_double* b, lapack_int ldb, + double* alpha, double* beta, + lapack_complex_double* u, lapack_int ldu, + lapack_complex_double* v, lapack_int ldv, + lapack_complex_double* q, lapack_int ldq, + lapack_int* iwork ); + lapack_int LAPACKE_sggsvp( int matrix_layout, char jobu, char jobv, char jobq, lapack_int m, lapack_int p, lapack_int n, float* a, lapack_int lda, float* b, lapack_int ldb, float tola, @@ -1506,6 +1540,36 @@ lapack_int LAPACKE_zggsvp( int matrix_layout, char jobu, char jobv, char jobq, lapack_int ldv, lapack_complex_double* q, lapack_int ldq ); +lapack_int LAPACKE_sggsvp3( int matrix_layout, char jobu, char jobv, char jobq, + lapack_int m, lapack_int p, lapack_int n, float* a, + lapack_int lda, float* b, lapack_int ldb, float tola, + float tolb, lapack_int* k, lapack_int* l, float* u, + lapack_int ldu, float* v, lapack_int ldv, float* q, + lapack_int ldq ); +lapack_int LAPACKE_dggsvp3( int matrix_layout, char jobu, char jobv, char jobq, + lapack_int m, lapack_int p, lapack_int n, double* a, + lapack_int lda, double* b, lapack_int ldb, + double tola, double tolb, lapack_int* k, + lapack_int* l, double* u, lapack_int ldu, double* v, + lapack_int ldv, double* q, lapack_int ldq ); +lapack_int LAPACKE_cggsvp3( int matrix_layout, char jobu, char jobv, char jobq, + lapack_int m, lapack_int p, lapack_int n, + lapack_complex_float* a, lapack_int lda, + lapack_complex_float* b, lapack_int ldb, float tola, + float tolb, lapack_int* k, lapack_int* l, + lapack_complex_float* u, lapack_int ldu, + lapack_complex_float* v, lapack_int ldv, + lapack_complex_float* q, lapack_int ldq ); +lapack_int LAPACKE_zggsvp3( int matrix_layout, char jobu, char jobv, char jobq, + lapack_int m, lapack_int p, lapack_int n, + lapack_complex_double* a, lapack_int lda, + lapack_complex_double* b, lapack_int ldb, + double tola, double tolb, lapack_int* k, + lapack_int* l, lapack_complex_double* u, + lapack_int ldu, lapack_complex_double* v, + lapack_int ldv, lapack_complex_double* q, + lapack_int ldq ); + lapack_int LAPACKE_sgtcon( char norm, lapack_int n, const float* dl, const float* d, const float* du, const float* du2, const lapack_int* ipiv, float anorm, float* rcond ); @@ -6049,32 +6113,32 @@ lapack_int LAPACKE_zgghrd_work( int matrix_layout, char compq, char compz, lapack_int LAPACKE_sgghd3_work( int matrix_layout, char compq, char compz, lapack_int n, lapack_int ilo, lapack_int ihi, float* a, lapack_int lda, - float* b, lapack_int ldb, - float* q, lapack_int ldq, - float* z, lapack_int ldz, - float* work, lapack_int lwork ); + float* b, lapack_int ldb, + float* q, lapack_int ldq, + float* z, lapack_int ldz, + float* work, lapack_int lwork ); lapack_int LAPACKE_dgghd3_work( int matrix_layout, char compq, char compz, lapack_int n, lapack_int ilo, lapack_int ihi, double* a, lapack_int lda, - double* b, lapack_int ldb, - double* q, lapack_int ldq, + double* b, lapack_int ldb, + double* q, lapack_int ldq, double* z, lapack_int ldz, - double* work, lapack_int lwork ); + double* work, lapack_int lwork ); lapack_int LAPACKE_cgghd3_work( int matrix_layout, char compq, char compz, - lapack_int n, lapack_int ilo, lapack_int ihi, - lapack_complex_float* a, lapack_int lda, - lapack_complex_float* b, lapack_int ldb, - lapack_complex_float* q, lapack_int ldq, - lapack_complex_float* z, lapack_int ldz, - lapack_complex_float* work, lapack_int lwork ); + lapack_int n, lapack_int ilo, lapack_int ihi, + lapack_complex_float* a, lapack_int lda, + lapack_complex_float* b, lapack_int ldb, + lapack_complex_float* q, lapack_int ldq, + lapack_complex_float* z, lapack_int ldz, + lapack_complex_float* work, lapack_int lwork ); lapack_int LAPACKE_zgghd3_work( int matrix_layout, char compq, char compz, lapack_int n, lapack_int ilo, lapack_int ihi, - lapack_complex_double* a, lapack_int lda, - lapack_complex_double* b, lapack_int ldb, - lapack_complex_double* q, lapack_int ldq, - lapack_complex_double* z, lapack_int ldz, - lapack_complex_double* work, - lapack_int lwork ); + lapack_complex_double* a, lapack_int lda, + lapack_complex_double* b, lapack_int ldb, + lapack_complex_double* q, lapack_int ldq, + lapack_complex_double* z, lapack_int ldz, + lapack_complex_double* work, + lapack_int lwork ); lapack_int LAPACKE_sgglse_work( int matrix_layout, lapack_int m, lapack_int n, lapack_int p, float* a, lapack_int lda, @@ -6180,6 +6244,47 @@ lapack_int LAPACKE_zggsvd_work( int matrix_layout, char jobu, char jobv, lapack_complex_double* work, double* rwork, lapack_int* iwork ); +lapack_int LAPACKE_sggsvd3_work( int matrix_layout, char jobu, char jobv, + char jobq, lapack_int m, lapack_int n, + lapack_int p, lapack_int* k, lapack_int* l, + float* a, lapack_int lda, float* b, + lapack_int ldb, float* alpha, float* beta, + float* u, lapack_int ldu, float* v, + lapack_int ldv, float* q, lapack_int ldq, + float* work, lapack_int lwork, + lapack_int* iwork ); +lapack_int LAPACKE_dggsvd3_work( int matrix_layout, char jobu, char jobv, + char jobq, lapack_int m, lapack_int n, + lapack_int p, lapack_int* k, lapack_int* l, + double* a, lapack_int lda, double* b, + lapack_int ldb, double* alpha, double* beta, + double* u, lapack_int ldu, double* v, + lapack_int ldv, double* q, lapack_int ldq, + double* work, lapack_int lwork, + lapack_int* iwork ); +lapack_int LAPACKE_cggsvd3_work( int matrix_layout, char jobu, char jobv, + char jobq, lapack_int m, lapack_int n, + lapack_int p, lapack_int* k, lapack_int* l, + lapack_complex_float* a, lapack_int lda, + lapack_complex_float* b, lapack_int ldb, + float* alpha, float* beta, + lapack_complex_float* u, lapack_int ldu, + lapack_complex_float* v, lapack_int ldv, + lapack_complex_float* q, lapack_int ldq, + lapack_complex_float* work, lapack_int lwork, + float* rwork, lapack_int* iwork ); +lapack_int LAPACKE_zggsvd3_work( int matrix_layout, char jobu, char jobv, + char jobq, lapack_int m, lapack_int n, + lapack_int p, lapack_int* k, lapack_int* l, + lapack_complex_double* a, lapack_int lda, + lapack_complex_double* b, lapack_int ldb, + double* alpha, double* beta, + lapack_complex_double* u, lapack_int ldu, + lapack_complex_double* v, lapack_int ldv, + lapack_complex_double* q, lapack_int ldq, + lapack_complex_double* work, lapack_int lwork, + double* rwork, lapack_int* iwork ); + lapack_int LAPACKE_sggsvp_work( int matrix_layout, char jobu, char jobv, char jobq, lapack_int m, lapack_int p, lapack_int n, float* a, lapack_int lda, @@ -6221,6 +6326,49 @@ lapack_int LAPACKE_zggsvp_work( int matrix_layout, char jobu, char jobv, lapack_complex_double* tau, lapack_complex_double* work ); +lapack_int LAPACKE_sggsvp3_work( int matrix_layout, char jobu, char jobv, + char jobq, lapack_int m, lapack_int p, + lapack_int n, float* a, lapack_int lda, + float* b, lapack_int ldb, float tola, + float tolb, lapack_int* k, lapack_int* l, + float* u, lapack_int ldu, float* v, + lapack_int ldv, float* q, lapack_int ldq, + lapack_int* iwork, float* tau, + float* work, lapack_int lwork ); +lapack_int LAPACKE_dggsvp3_work( int matrix_layout, char jobu, char jobv, + char jobq, lapack_int m, lapack_int p, + lapack_int n, double* a, lapack_int lda, + double* b, lapack_int ldb, double tola, + double tolb, lapack_int* k, lapack_int* l, + double* u, lapack_int ldu, double* v, + lapack_int ldv, double* q, lapack_int ldq, + lapack_int* iwork, double* tau, double* work, + lapack_int lwork ); +lapack_int LAPACKE_cggsvp3_work( int matrix_layout, char jobu, char jobv, + char jobq, lapack_int m, lapack_int p, + lapack_int n, lapack_complex_float* a, + lapack_int lda, lapack_complex_float* b, + lapack_int ldb, float tola, float tolb, + lapack_int* k, lapack_int* l, + lapack_complex_float* u, lapack_int ldu, + lapack_complex_float* v, lapack_int ldv, + lapack_complex_float* q, lapack_int ldq, + lapack_int* iwork, float* rwork, + lapack_complex_float* tau, + lapack_complex_float* work, lapack_int lwork ); +lapack_int LAPACKE_zggsvp3_work( int matrix_layout, char jobu, char jobv, + char jobq, lapack_int m, lapack_int p, + lapack_int n, lapack_complex_double* a, + lapack_int lda, lapack_complex_double* b, + lapack_int ldb, double tola, double tolb, + lapack_int* k, lapack_int* l, + lapack_complex_double* u, lapack_int ldu, + lapack_complex_double* v, lapack_int ldv, + lapack_complex_double* q, lapack_int ldq, + lapack_int* iwork, double* rwork, + lapack_complex_double* tau, + lapack_complex_double* work, lapack_int lwork ); + lapack_int LAPACKE_sgtcon_work( char norm, lapack_int n, const float* dl, const float* d, const float* du, const float* du2, const lapack_int* ipiv, @@ -11577,6 +11725,10 @@ void LAPACKE_ilaver( const lapack_int* vers_major, #define LAPACK_dggsvp LAPACK_GLOBAL(dggsvp,DGGSVP) #define LAPACK_cggsvp LAPACK_GLOBAL(cggsvp,CGGSVP) #define LAPACK_zggsvp LAPACK_GLOBAL(zggsvp,ZGGSVP) +#define LAPACK_sggsvp3 LAPACK_GLOBAL(sggsvp3,SGGSVP3) +#define LAPACK_dggsvp3 LAPACK_GLOBAL(dggsvp3,DGGSVP3) +#define LAPACK_cggsvp3 LAPACK_GLOBAL(cggsvp3,CGGSVP3) +#define LAPACK_zggsvp3 LAPACK_GLOBAL(zggsvp3,ZGGSVP3) #define LAPACK_stgsja LAPACK_GLOBAL(stgsja,STGSJA) #define LAPACK_dtgsja LAPACK_GLOBAL(dtgsja,DTGSJA) #define LAPACK_ctgsja LAPACK_GLOBAL(ctgsja,CTGSJA) @@ -11685,6 +11837,10 @@ void LAPACKE_ilaver( const lapack_int* vers_major, #define LAPACK_dggsvd LAPACK_GLOBAL(dggsvd,DGGSVD) #define LAPACK_cggsvd LAPACK_GLOBAL(cggsvd,CGGSVD) #define LAPACK_zggsvd LAPACK_GLOBAL(zggsvd,ZGGSVD) +#define LAPACK_sggsvd3 LAPACK_GLOBAL(sggsvd3,SGGSVD3) +#define LAPACK_dggsvd3 LAPACK_GLOBAL(dggsvd3,DGGSVD3) +#define LAPACK_cggsvd3 LAPACK_GLOBAL(cggsvd3,CGGSVD3) +#define LAPACK_zggsvd3 LAPACK_GLOBAL(zggsvd3,ZGGSVD3) #define LAPACK_ssygv LAPACK_GLOBAL(ssygv,SSYGV) #define LAPACK_dsygv LAPACK_GLOBAL(dsygv,DSYGV) #define LAPACK_chegv LAPACK_GLOBAL(chegv,CHEGV) @@ -14730,12 +14886,12 @@ void LAPACK_sgghd3( char* compq, char* compz, lapack_int* n, lapack_int* ilo, lapack_int* ihi, float* a, lapack_int* lda, float* b, lapack_int* ldb, float* q, lapack_int* ldq, float* z, lapack_int* ldz, float* work, lapack_int* lwork, - lapack_int *info ); + lapack_int *info ); void LAPACK_dgghd3( char* compq, char* compz, lapack_int* n, lapack_int* ilo, lapack_int* ihi, double* a, lapack_int* lda, double* b, lapack_int* ldb, double* q, lapack_int* ldq, double* z, lapack_int* ldz, double* work, lapack_int* lwork, - lapack_int *info ); + lapack_int *info ); void LAPACK_cgghd3( char* compq, char* compz, lapack_int* n, lapack_int* ilo, lapack_int* ihi, lapack_complex_float* a, lapack_int* lda, @@ -14745,13 +14901,13 @@ void LAPACK_cgghd3( char* compq, char* compz, lapack_int* n, lapack_complex_float* work, lapack_int* lwork, lapack_int *info ); void LAPACK_zgghd3( char* compq, char* compz, lapack_int* n, - lapack_int* ilo, lapack_int* ihi, - lapack_complex_double* a, lapack_int* lda, - lapack_complex_double* b, lapack_int* ldb, - lapack_complex_double* q, lapack_int* ldq, - lapack_complex_double* z, lapack_int* ldz, - lapack_complex_double* work, lapack_int* lwork, - lapack_int *info ); + lapack_int* ilo, lapack_int* ihi, + lapack_complex_double* a, lapack_int* lda, + lapack_complex_double* b, lapack_int* ldb, + lapack_complex_double* q, lapack_int* ldq, + lapack_complex_double* z, lapack_int* ldz, + lapack_complex_double* work, lapack_int* lwork, + lapack_int *info ); void LAPACK_sggbal( char* job, lapack_int* n, float* a, lapack_int* lda, float* b, lapack_int* ldb, lapack_int* ilo, lapack_int* ihi, float* lscale, float* rscale, float* work, @@ -14991,6 +15147,40 @@ void LAPACK_zggsvp( char* jobu, char* jobv, char* jobq, lapack_int* m, lapack_int* iwork, double* rwork, lapack_complex_double* tau, lapack_complex_double* work, lapack_int *info ); +void LAPACK_sggsvp3( char* jobu, char* jobv, char* jobq, lapack_int* m, + lapack_int* p, lapack_int* n, float* a, lapack_int* lda, + float* b, lapack_int* ldb, float* tola, float* tolb, + lapack_int* k, lapack_int* l, float* u, lapack_int* ldu, + float* v, lapack_int* ldv, float* q, lapack_int* ldq, + lapack_int* iwork, float* tau, float* work, + lapack_int* lwork, lapack_int *info ); +void LAPACK_dggsvp3( char* jobu, char* jobv, char* jobq, lapack_int* m, + lapack_int* p, lapack_int* n, double* a, lapack_int* lda, + double* b, lapack_int* ldb, double* tola, double* tolb, + lapack_int* k, lapack_int* l, double* u, lapack_int* ldu, + double* v, lapack_int* ldv, double* q, lapack_int* ldq, + lapack_int* iwork, double* tau, double* work, + lapack_int* lwork, lapack_int *info ); +void LAPACK_cggsvp3( char* jobu, char* jobv, char* jobq, lapack_int* m, + lapack_int* p, lapack_int* n, lapack_complex_float* a, + lapack_int* lda, lapack_complex_float* b, lapack_int* ldb, + float* tola, float* tolb, lapack_int* k, lapack_int* l, + lapack_complex_float* u, lapack_int* ldu, + lapack_complex_float* v, lapack_int* ldv, + lapack_complex_float* q, lapack_int* ldq, lapack_int* iwork, + float* rwork, lapack_complex_float* tau, + lapack_complex_float* work, lapack_int* lwork, + lapack_int *info ); +void LAPACK_zggsvp3( char* jobu, char* jobv, char* jobq, lapack_int* m, + lapack_int* p, lapack_int* n, lapack_complex_double* a, + lapack_int* lda, lapack_complex_double* b, lapack_int* ldb, + double* tola, double* tolb, lapack_int* k, lapack_int* l, + lapack_complex_double* u, lapack_int* ldu, + lapack_complex_double* v, lapack_int* ldv, + lapack_complex_double* q, lapack_int* ldq, + lapack_int* iwork, double* rwork, + lapack_complex_double* tau, lapack_complex_double* work, + lapack_int* lwork, lapack_int *info ); void LAPACK_stgsja( char* jobu, char* jobv, char* jobq, lapack_int* m, lapack_int* p, lapack_int* n, lapack_int* k, lapack_int* l, float* a, lapack_int* lda, float* b, lapack_int* ldb, @@ -15556,6 +15746,38 @@ void LAPACK_zggsvd( char* jobu, char* jobv, char* jobq, lapack_int* m, lapack_complex_double* q, lapack_int* ldq, lapack_complex_double* work, double* rwork, lapack_int* iwork, lapack_int *info ); +void LAPACK_sggsvd3( char* jobu, char* jobv, char* jobq, lapack_int* m, + lapack_int* n, lapack_int* p, lapack_int* k, lapack_int* l, + float* a, lapack_int* lda, float* b, lapack_int* ldb, + float* alpha, float* beta, float* u, lapack_int* ldu, + float* v, lapack_int* ldv, float* q, lapack_int* ldq, + float* work, lapack_int* lwork, lapack_int* iwork, + lapack_int *info ); +void LAPACK_dggsvd3( char* jobu, char* jobv, char* jobq, lapack_int* m, + lapack_int* n, lapack_int* p, lapack_int* k, lapack_int* l, + double* a, lapack_int* lda, double* b, lapack_int* ldb, + double* alpha, double* beta, double* u, lapack_int* ldu, + double* v, lapack_int* ldv, double* q, lapack_int* ldq, + double* work, lapack_int* lwork, lapack_int* iwork, + lapack_int *info ); +void LAPACK_cggsvd3( char* jobu, char* jobv, char* jobq, lapack_int* m, + lapack_int* n, lapack_int* p, lapack_int* k, lapack_int* l, + lapack_complex_float* a, lapack_int* lda, + lapack_complex_float* b, lapack_int* ldb, float* alpha, + float* beta, lapack_complex_float* u, lapack_int* ldu, + lapack_complex_float* v, lapack_int* ldv, + lapack_complex_float* q, lapack_int* ldq, + lapack_complex_float* work, lapack_int* lwork, float* rwork, + lapack_int* iwork, lapack_int *info ); +void LAPACK_zggsvd3( char* jobu, char* jobv, char* jobq, lapack_int* m, + lapack_int* n, lapack_int* p, lapack_int* k, lapack_int* l, + lapack_complex_double* a, lapack_int* lda, + lapack_complex_double* b, lapack_int* ldb, double* alpha, + double* beta, lapack_complex_double* u, lapack_int* ldu, + lapack_complex_double* v, lapack_int* ldv, + lapack_complex_double* q, lapack_int* ldq, + lapack_complex_double* work, lapack_int* lwork, + double* rwork, lapack_int* iwork, lapack_int *info ); void LAPACK_ssygv( lapack_int* itype, char* jobz, char* uplo, lapack_int* n, float* a, lapack_int* lda, float* b, lapack_int* ldb, float* w, float* work, lapack_int* lwork, lapack_int *info ); diff --git a/LAPACKE/src/CMakeLists.txt b/LAPACKE/src/CMakeLists.txt index 4a0a319..6bc7e35 100644 --- a/LAPACKE/src/CMakeLists.txt +++ b/LAPACKE/src/CMakeLists.txt @@ -127,8 +127,12 @@ lapacke_cggrqf.c lapacke_cggrqf_work.c lapacke_cggsvd.c lapacke_cggsvd_work.c +lapacke_cggsvd3.c +lapacke_cggsvd3_work.c lapacke_cggsvp.c lapacke_cggsvp_work.c +lapacke_cggsvp3.c +lapacke_cggsvp3_work.c lapacke_cgtcon.c lapacke_cgtcon_work.c lapacke_cgtrfs.c @@ -637,10 +641,12 @@ lapacke_dggqrf.c lapacke_dggqrf_work.c lapacke_dggrqf.c lapacke_dggrqf_work.c -lapacke_dggsvd.c -lapacke_dggsvd_work.c +lapacke_dggsvd3.c +lapacke_dggsvd3_work.c lapacke_dggsvp.c lapacke_dggsvp_work.c +lapacke_dggsvp3.c +lapacke_dggsvp3_work.c lapacke_dgtcon.c lapacke_dgtcon_work.c lapacke_dgtrfs.c @@ -1135,8 +1141,12 @@ lapacke_sggrqf.c lapacke_sggrqf_work.c lapacke_sggsvd.c lapacke_sggsvd_work.c +lapacke_sggsvd3.c +lapacke_sggsvd3_work.c lapacke_sggsvp.c lapacke_sggsvp_work.c +lapacke_sggsvp3.c +lapacke_sggsvp3_work.c lapacke_sgtcon.c lapacke_sgtcon_work.c lapacke_sgtrfs.c @@ -1623,8 +1633,12 @@ lapacke_zggrqf.c lapacke_zggrqf_work.c lapacke_zggsvd.c lapacke_zggsvd_work.c +lapacke_zggsvd3.c +lapacke_zggsvd3_work.c lapacke_zggsvp.c lapacke_zggsvp_work.c +lapacke_zggsvp3.c +lapacke_zggsvp3_work.c lapacke_zgtcon.c lapacke_zgtcon_work.c lapacke_zgtrfs.c diff --git a/LAPACKE/src/Makefile b/LAPACKE/src/Makefile index 28583ee..060be14 100644 --- a/LAPACKE/src/Makefile +++ b/LAPACKE/src/Makefile @@ -161,8 +161,12 @@ lapacke_cggrqf.o \ lapacke_cggrqf_work.o \ lapacke_cggsvd.o \ lapacke_cggsvd_work.o \ +lapacke_cggsvd3.o \ +lapacke_cggsvd3_work.o \ lapacke_cggsvp.o \ lapacke_cggsvp_work.o \ +lapacke_cggsvp3.o \ +lapacke_cggsvp3_work.o \ lapacke_cgtcon.o \ lapacke_cgtcon_work.o \ lapacke_cgtrfs.o \ @@ -673,8 +677,12 @@ lapacke_dggrqf.o \ lapacke_dggrqf_work.o \ lapacke_dggsvd.o \ lapacke_dggsvd_work.o \ +lapacke_dggsvd3.o \ +lapacke_dggsvd3_work.o \ lapacke_dggsvp.o \ lapacke_dggsvp_work.o \ +lapacke_dggsvp3.o \ +lapacke_dggsvp3_work.o \ lapacke_dgtcon.o \ lapacke_dgtcon_work.o \ lapacke_dgtrfs.o \ @@ -1169,8 +1177,12 @@ lapacke_sggrqf.o \ lapacke_sggrqf_work.o \ lapacke_sggsvd.o \ lapacke_sggsvd_work.o \ +lapacke_sggsvd3.o \ +lapacke_sggsvd3_work.o \ lapacke_sggsvp.o \ lapacke_sggsvp_work.o \ +lapacke_sggsvp3.o \ +lapacke_sggsvp3_work.o \ lapacke_sgtcon.o \ lapacke_sgtcon_work.o \ lapacke_sgtrfs.o \ @@ -1657,8 +1669,12 @@ lapacke_zggrqf.o \ lapacke_zggrqf_work.o \ lapacke_zggsvd.o \ lapacke_zggsvd_work.o \ +lapacke_zggsvd3.o \ +lapacke_zggsvd3_work.o \ lapacke_zggsvp.o \ lapacke_zggsvp_work.o \ +lapacke_zggsvp3.o \ +lapacke_zggsvp3_work.o \ lapacke_zgtcon.o \ lapacke_zgtcon_work.o \ lapacke_zgtrfs.o \ diff --git a/LAPACKE/src/lapacke_cggsvd3.c b/LAPACKE/src/lapacke_cggsvd3.c new file mode 100644 index 0000000..97995ae --- /dev/null +++ b/LAPACKE/src/lapacke_cggsvd3.c @@ -0,0 +1,96 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native high-level C interface to LAPACK function cggsvd3 +* Author: Intel Corporation +* Generated August, 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_cggsvd3( int matrix_layout, char jobu, char jobv, char jobq, + lapack_int m, lapack_int n, lapack_int p, + lapack_int* k, lapack_int* l, + lapack_complex_float* a, lapack_int lda, + lapack_complex_float* b, lapack_int ldb, + float* alpha, float* beta, lapack_complex_float* u, + lapack_int ldu, lapack_complex_float* v, + lapack_int ldv, lapack_complex_float* q, + lapack_int ldq, lapack_int* iwork ) +{ + lapack_int info = 0; + float* rwork = NULL; + lapack_int lwork = -1; + lapack_complex_float* work = NULL; + lapack_complex_float work_query; + if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { + LAPACKE_xerbla( "LAPACKE_cggsvd3", -1 ); + return -1; + } +#ifndef LAPACK_DISABLE_NAN_CHECK + /* Optionally check input matrices for NaNs */ + if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) { + return -10; + } + if( LAPACKE_cge_nancheck( matrix_layout, p, n, b, ldb ) ) { + return -12; + } +#endif + /* Query optimal size for working array */ + info = LAPACKE_cggsvd3_work( matrix_layout, jobu, jobv, jobq, m, n, p, k, l, + a, lda, b, ldb, alpha, beta, u, ldu, v, ldv, q, + ldq, &work_query, lwork, rwork, iwork ); + if( info != 0 ) + goto exit_level_0; + lwork = LAPACK_C2INT( work_query ); + /* Allocate memory for working array(s) */ + rwork = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,2*n) ); + if( rwork == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_0; + } + work = (lapack_complex_float*) + LAPACKE_malloc( sizeof(lapack_complex_float) * lwork ); + if( work == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_1; + } + /* Call middle-level interface */ + info = LAPACKE_cggsvd3_work( matrix_layout, jobu, jobv, jobq, m, n, p, k, l, + a, lda, b, ldb, alpha, beta, u, ldu, v, ldv, q, + ldq, work, lwork, rwork, iwork ); + /* Release memory and exit */ + LAPACKE_free( work ); +exit_level_1: + LAPACKE_free( rwork ); +exit_level_0: + if( info == LAPACK_WORK_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_cggsvd3", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_cggsvd3_work.c b/LAPACKE/src/lapacke_cggsvd3_work.c new file mode 100644 index 0000000..652e8b7 --- /dev/null +++ b/LAPACKE/src/lapacke_cggsvd3_work.c @@ -0,0 +1,189 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native middle-level C interface to LAPACK function cggsvd3 +* Author: Intel Corporation +* Generated August, 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_cggsvd3_work( int matrix_layout, char jobu, char jobv, + char jobq, lapack_int m, lapack_int n, + lapack_int p, lapack_int* k, lapack_int* l, + lapack_complex_float* a, lapack_int lda, + lapack_complex_float* b, lapack_int ldb, + float* alpha, float* beta, + lapack_complex_float* u, lapack_int ldu, + lapack_complex_float* v, lapack_int ldv, + lapack_complex_float* q, lapack_int ldq, + lapack_complex_float* work, lapack_int lwork, + float* rwork, lapack_int* iwork ) +{ + lapack_int info = 0; + if( matrix_layout == LAPACK_COL_MAJOR ) { + /* Call LAPACK function and adjust info */ + LAPACK_cggsvd3( &jobu, &jobv, &jobq, &m, &n, &p, k, l, a, &lda, b, &ldb, + alpha, beta, u, &ldu, v, &ldv, q, &ldq, work, &lwork, + rwork, iwork, &info ); + if( info < 0 ) { + info = info - 1; + } + } else if( matrix_layout == LAPACK_ROW_MAJOR ) { + lapack_int lda_t = MAX(1,m); + lapack_int ldb_t = MAX(1,p); + lapack_int ldq_t = MAX(1,n); + lapack_int ldu_t = MAX(1,m); + lapack_int ldv_t = MAX(1,p); + lapack_complex_float* a_t = NULL; + lapack_complex_float* b_t = NULL; + lapack_complex_float* u_t = NULL; + lapack_complex_float* v_t = NULL; + lapack_complex_float* q_t = NULL; + /* Check leading dimension(s) */ + if( lda < n ) { + info = -11; + LAPACKE_xerbla( "LAPACKE_cggsvd3_work", info ); + return info; + } + if( ldb < n ) { + info = -13; + LAPACKE_xerbla( "LAPACKE_cggsvd3_work", info ); + return info; + } + if( ldq < n ) { + info = -21; + LAPACKE_xerbla( "LAPACKE_cggsvd3_work", info ); + return info; + } + if( ldu < m ) { + info = -17; + LAPACKE_xerbla( "LAPACKE_cggsvd3_work", info ); + return info; + } + if( ldv < p ) { + info = -19; + LAPACKE_xerbla( "LAPACKE_cggsvd3_work", info ); + return info; + } + /* Query optimal working array(s) size if requested */ + if( lwork == -1 ) { + LAPACK_cggsvd3( &jobu, &jobv, &jobq, &m, &n, &p, k, l, a_t, + &lda_t, b_t, &ldb_t, alpha, beta, u_t, &ldu_t, + v_t, &ldv_t, q_t, &ldq_t, work, &lwork, rwork, + iwork, &info ); + return (info < 0) ? (info - 1) : info; + } + /* Allocate memory for temporary array(s) */ + a_t = (lapack_complex_float*) + LAPACKE_malloc( sizeof(lapack_complex_float) * lda_t * MAX(1,n) ); + if( a_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_0; + } + b_t = (lapack_complex_float*) + LAPACKE_malloc( sizeof(lapack_complex_float) * ldb_t * MAX(1,n) ); + if( b_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_1; + } + if( LAPACKE_lsame( jobu, 'u' ) ) { + u_t = (lapack_complex_float*) + LAPACKE_malloc( sizeof(lapack_complex_float) * + ldu_t * MAX(1,m) ); + if( u_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_2; + } + } + if( LAPACKE_lsame( jobv, 'v' ) ) { + v_t = (lapack_complex_float*) + LAPACKE_malloc( sizeof(lapack_complex_float) * + ldv_t * MAX(1,p) ); + if( v_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_3; + } + } + if( LAPACKE_lsame( jobq, 'q' ) ) { + q_t = (lapack_complex_float*) + LAPACKE_malloc( sizeof(lapack_complex_float) * + ldq_t * MAX(1,n) ); + if( q_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_4; + } + } + /* Transpose input matrices */ + LAPACKE_cge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + LAPACKE_cge_trans( matrix_layout, p, n, b, ldb, b_t, ldb_t ); + /* Call LAPACK function and adjust info */ + LAPACK_cggsvd3( &jobu, &jobv, &jobq, &m, &n, &p, k, l, a_t, &lda_t, b_t, + &ldb_t, alpha, beta, u_t, &ldu_t, v_t, &ldv_t, q_t, + &ldq_t, work, &lwork, rwork, iwork, &info ); + if( info < 0 ) { + info = info - 1; + } + /* Transpose output matrices */ + LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + LAPACKE_cge_trans( LAPACK_COL_MAJOR, p, n, b_t, ldb_t, b, ldb ); + if( LAPACKE_lsame( jobu, 'u' ) ) { + LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, m, u_t, ldu_t, u, ldu ); + } + if( LAPACKE_lsame( jobv, 'v' ) ) { + LAPACKE_cge_trans( LAPACK_COL_MAJOR, p, p, v_t, ldv_t, v, ldv ); + } + if( LAPACKE_lsame( jobq, 'q' ) ) { + LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); + } + /* Release memory and exit */ + if( LAPACKE_lsame( jobq, 'q' ) ) { + LAPACKE_free( q_t ); + } +exit_level_4: + if( LAPACKE_lsame( jobv, 'v' ) ) { + LAPACKE_free( v_t ); + } +exit_level_3: + if( LAPACKE_lsame( jobu, 'u' ) ) { + LAPACKE_free( u_t ); + } +exit_level_2: + LAPACKE_free( b_t ); +exit_level_1: + LAPACKE_free( a_t ); +exit_level_0: + if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_cggsvd3_work", info ); + } + } else { + info = -1; + LAPACKE_xerbla( "LAPACKE_cggsvd3_work", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_cggsvp3.c b/LAPACKE/src/lapacke_cggsvp3.c new file mode 100644 index 0000000..25cc974 --- /dev/null +++ b/LAPACKE/src/lapacke_cggsvp3.c @@ -0,0 +1,119 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native high-level C interface to LAPACK function cggsvp3 +* Author: Intel Corporation +* Generated August, 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_cggsvp3( int matrix_layout, char jobu, char jobv, char jobq, + lapack_int m, lapack_int p, lapack_int n, + lapack_complex_float* a, lapack_int lda, + lapack_complex_float* b, lapack_int ldb, float tola, + float tolb, lapack_int* k, lapack_int* l, + lapack_complex_float* u, lapack_int ldu, + lapack_complex_float* v, lapack_int ldv, + lapack_complex_float* q, lapack_int ldq ) +{ + lapack_int info = 0; + lapack_int* iwork = NULL; + float* rwork = NULL; + lapack_complex_float* tau = NULL; + lapack_complex_float* work = NULL; + lapack_int lwork = -1; + lapack_complex_float work_query; + if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { + LAPACKE_xerbla( "LAPACKE_cggsvp3", -1 ); + return -1; + } +#ifndef LAPACK_DISABLE_NAN_CHECK + /* Optionally check input matrices for NaNs */ + if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) { + return -8; + } + if( LAPACKE_cge_nancheck( matrix_layout, p, n, b, ldb ) ) { + return -10; + } + if( LAPACKE_s_nancheck( 1, &tola, 1 ) ) { + return -12; + } + if( LAPACKE_s_nancheck( 1, &tolb, 1 ) ) { + return -13; + } +#endif + /* Query optimal size for working array */ + info = LAPACKE_cggsvp3_work( matrix_layout, jobu, jobv, jobq, m, p, n, + a, lda, b, ldb, tola, tolb, k, l, u, ldu, + v, ldv, q, ldq, iwork, rwork, tau, + &work_query, lwork ); + if( info != 0 ) + goto exit_level_0; + lwork = LAPACK_C2INT( work_query ); + /* Allocate memory for working array(s) */ + iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n) ); + if( iwork == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_0; + } + rwork = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,2*n) ); + if( rwork == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_1; + } + tau = (lapack_complex_float*) + LAPACKE_malloc( sizeof(lapack_complex_float) * MAX(1,n) ); + if( tau == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_2; + } + work = (lapack_complex_float*) + LAPACKE_malloc( sizeof(lapack_complex_float) * lwork ); + if( work == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_3; + } + /* Call middle-level interface */ + info = LAPACKE_cggsvp3_work( matrix_layout, jobu, jobv, jobq, m, p, n, a, lda, + b, ldb, tola, tolb, k, l, u, ldu, v, ldv, q, + ldq, iwork, rwork, tau, work, lwork ); + /* Release memory and exit */ + LAPACKE_free( work ); +exit_level_3: + LAPACKE_free( tau ); +exit_level_2: + LAPACKE_free( rwork ); +exit_level_1: + LAPACKE_free( iwork ); +exit_level_0: + if( info == LAPACK_WORK_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_cggsvp3", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_cggsvp3_work.c b/LAPACKE/src/lapacke_cggsvp3_work.c new file mode 100644 index 0000000..d532391 --- /dev/null +++ b/LAPACKE/src/lapacke_cggsvp3_work.c @@ -0,0 +1,189 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native middle-level C interface to LAPACK function cggsvp3 +* Author: Intel Corporation +* Generated August, 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_cggsvp3_work( int matrix_layout, char jobu, char jobv, + char jobq, lapack_int m, lapack_int p, + lapack_int n, lapack_complex_float* a, + lapack_int lda, lapack_complex_float* b, + lapack_int ldb, float tola, float tolb, + lapack_int* k, lapack_int* l, + lapack_complex_float* u, lapack_int ldu, + lapack_complex_float* v, lapack_int ldv, + lapack_complex_float* q, lapack_int ldq, + lapack_int* iwork, float* rwork, + lapack_complex_float* tau, + lapack_complex_float* work, lapack_int lwork ) +{ + lapack_int info = 0; + if( matrix_layout == LAPACK_COL_MAJOR ) { + /* Call LAPACK function and adjust info */ + LAPACK_cggsvp3( &jobu, &jobv, &jobq, &m, &p, &n, a, &lda, b, &ldb, &tola, + &tolb, k, l, u, &ldu, v, &ldv, q, &ldq, iwork, rwork, + tau, work, &lwork, &info ); + if( info < 0 ) { + info = info - 1; + } + } else if( matrix_layout == LAPACK_ROW_MAJOR ) { + lapack_int lda_t = MAX(1,m); + lapack_int ldb_t = MAX(1,p); + lapack_int ldq_t = MAX(1,n); + lapack_int ldu_t = MAX(1,m); + lapack_int ldv_t = MAX(1,p); + lapack_complex_float* a_t = NULL; + lapack_complex_float* b_t = NULL; + lapack_complex_float* u_t = NULL; + lapack_complex_float* v_t = NULL; + lapack_complex_float* q_t = NULL; + /* Check leading dimension(s) */ + if( lda < n ) { + info = -9; + LAPACKE_xerbla( "LAPACKE_cggsvp3_work", info ); + return info; + } + if( ldb < n ) { + info = -11; + LAPACKE_xerbla( "LAPACKE_cggsvp3_work", info ); + return info; + } + if( ldq < n ) { + info = -21; + LAPACKE_xerbla( "LAPACKE_cggsvp3_work", info ); + return info; + } + if( ldu < m ) { + info = -17; + LAPACKE_xerbla( "LAPACKE_cggsvp3_work", info ); + return info; + } + if( ldv < m ) { + info = -19; + LAPACKE_xerbla( "LAPACKE_cggsvp3_work", info ); + return info; + } + /* Query optimal working array(s) size if requested */ + if( lwork == -1 ) { + LAPACK_cggsvp3( &jobu, &jobv, &jobq, &m, &p, &n, a_t, &lda_t, b_t, + &ldb_t, &tola, &tolb, k, l, u_t, &ldu_t, v_t, &ldv_t, + q_t, &ldq_t, iwork, rwork, tau, work, &lwork, &info ); + return (info < 0) ? (info - 1) : info; + } + /* Allocate memory for temporary array(s) */ + a_t = (lapack_complex_float*) + LAPACKE_malloc( sizeof(lapack_complex_float) * lda_t * MAX(1,n) ); + if( a_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_0; + } + b_t = (lapack_complex_float*) + LAPACKE_malloc( sizeof(lapack_complex_float) * ldb_t * MAX(1,n) ); + if( b_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_1; + } + if( LAPACKE_lsame( jobu, 'u' ) ) { + u_t = (lapack_complex_float*) + LAPACKE_malloc( sizeof(lapack_complex_float) * + ldu_t * MAX(1,m) ); + if( u_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_2; + } + } + if( LAPACKE_lsame( jobv, 'v' ) ) { + v_t = (lapack_complex_float*) + LAPACKE_malloc( sizeof(lapack_complex_float) * + ldv_t * MAX(1,m) ); + if( v_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_3; + } + } + if( LAPACKE_lsame( jobq, 'q' ) ) { + q_t = (lapack_complex_float*) + LAPACKE_malloc( sizeof(lapack_complex_float) * + ldq_t * MAX(1,n) ); + if( q_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_4; + } + } + /* Transpose input matrices */ + LAPACKE_cge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + LAPACKE_cge_trans( matrix_layout, p, n, b, ldb, b_t, ldb_t ); + /* Call LAPACK function and adjust info */ + LAPACK_cggsvp3( &jobu, &jobv, &jobq, &m, &p, &n, a_t, &lda_t, b_t, + &ldb_t, &tola, &tolb, k, l, u_t, &ldu_t, v_t, &ldv_t, + q_t, &ldq_t, iwork, rwork, tau, work, &lwork, &info ); + if( info < 0 ) { + info = info - 1; + } + /* Transpose output matrices */ + LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + LAPACKE_cge_trans( LAPACK_COL_MAJOR, p, n, b_t, ldb_t, b, ldb ); + if( LAPACKE_lsame( jobu, 'u' ) ) { + LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, m, u_t, ldu_t, u, ldu ); + } + if( LAPACKE_lsame( jobv, 'v' ) ) { + LAPACKE_cge_trans( LAPACK_COL_MAJOR, p, m, v_t, ldv_t, v, ldv ); + } + if( LAPACKE_lsame( jobq, 'q' ) ) { + LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); + } + /* Release memory and exit */ + if( LAPACKE_lsame( jobq, 'q' ) ) { + LAPACKE_free( q_t ); + } +exit_level_4: + if( LAPACKE_lsame( jobv, 'v' ) ) { + LAPACKE_free( v_t ); + } +exit_level_3: + if( LAPACKE_lsame( jobu, 'u' ) ) { + LAPACKE_free( u_t ); + } +exit_level_2: + LAPACKE_free( b_t ); +exit_level_1: + LAPACKE_free( a_t ); +exit_level_0: + if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_cggsvp3_work", info ); + } + } else { + info = -1; + LAPACKE_xerbla( "LAPACKE_cggsvp3_work", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_dggsvd3.c b/LAPACKE/src/lapacke_dggsvd3.c new file mode 100644 index 0000000..ee3bcfc --- /dev/null +++ b/LAPACKE/src/lapacke_dggsvd3.c @@ -0,0 +1,84 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native high-level C interface to LAPACK function dggsvd3 +* Author: Intel Corporation +* Generated August, 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_dggsvd3( int matrix_layout, char jobu, char jobv, char jobq, + lapack_int m, lapack_int n, lapack_int p, + lapack_int* k, lapack_int* l, double* a, + lapack_int lda, double* b, lapack_int ldb, + double* alpha, double* beta, double* u, + lapack_int ldu, double* v, lapack_int ldv, double* q, + lapack_int ldq, lapack_int* iwork ) +{ + lapack_int info = 0; + double* work = NULL; + lapack_int lwork = -1; + double work_query; + if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { + LAPACKE_xerbla( "LAPACKE_dggsvd3", -1 ); + return -1; + } +#ifndef LAPACK_DISABLE_NAN_CHECK + /* Optionally check input matrices for NaNs */ + if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) { + return -10; + } + if( LAPACKE_dge_nancheck( matrix_layout, p, n, b, ldb ) ) { + return -12; + } +#endif + info = LAPACKE_dggsvd3_work( matrix_layout, jobu, jobv, jobq, m, n, p, k, l, + a, lda, b, ldb, alpha, beta, u, ldu, v, ldv, q, + ldq, &work_query, lwork, iwork ); + if( info != 0 ) + goto exit_level_0; + lwork = work_query; + /* Allocate memory for working array(s) */ + work = (double*)LAPACKE_malloc( sizeof(double) * lwork ); + if( work == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_0; + } + /* Call middle-level interface */ + info = LAPACKE_dggsvd3_work( matrix_layout, jobu, jobv, jobq, m, n, p, k, l, + a, lda, b, ldb, alpha, beta, u, ldu, v, ldv, q, + ldq, work, lwork, iwork ); + /* Release memory and exit */ + LAPACKE_free( work ); +exit_level_0: + if( info == LAPACK_WORK_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_dggsvd3", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_dggsvd3_work.c b/LAPACKE/src/lapacke_dggsvd3_work.c new file mode 100644 index 0000000..dcc6bc8 --- /dev/null +++ b/LAPACKE/src/lapacke_dggsvd3_work.c @@ -0,0 +1,178 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native middle-level C interface to LAPACK function dggsvd3 +* Author: Intel Corporation +* Generated August, 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_dggsvd3_work( int matrix_layout, char jobu, char jobv, + char jobq, lapack_int m, lapack_int n, + lapack_int p, lapack_int* k, lapack_int* l, + double* a, lapack_int lda, double* b, + lapack_int ldb, double* alpha, double* beta, + double* u, lapack_int ldu, double* v, + lapack_int ldv, double* q, lapack_int ldq, + double* work, lapack_int lwork, + lapack_int* iwork ) +{ + lapack_int info = 0; + if( matrix_layout == LAPACK_COL_MAJOR ) { + /* Call LAPACK function and adjust info */ + LAPACK_dggsvd3( &jobu, &jobv, &jobq, &m, &n, &p, k, l, a, &lda, b, &ldb, + alpha, beta, u, &ldu, v, &ldv, q, &ldq, work, &lwork, + iwork, &info ); + if( info < 0 ) { + info = info - 1; + } + } else if( matrix_layout == LAPACK_ROW_MAJOR ) { + lapack_int lda_t = MAX(1,m); + lapack_int ldb_t = MAX(1,p); + lapack_int ldq_t = MAX(1,n); + lapack_int ldu_t = MAX(1,m); + lapack_int ldv_t = MAX(1,p); + double* a_t = NULL; + double* b_t = NULL; + double* u_t = NULL; + double* v_t = NULL; + double* q_t = NULL; + /* Check leading dimension(s) */ + if( lda < n ) { + info = -11; + LAPACKE_xerbla( "LAPACKE_dggsvd3_work", info ); + return info; + } + if( ldb < n ) { + info = -13; + LAPACKE_xerbla( "LAPACKE_dggsvd3_work", info ); + return info; + } + if( ldq < n ) { + info = -21; + LAPACKE_xerbla( "LAPACKE_dggsvd3_work", info ); + return info; + } + if( ldu < m ) { + info = -17; + LAPACKE_xerbla( "LAPACKE_dggsvd3_work", info ); + return info; + } + if( ldv < p ) { + info = -19; + LAPACKE_xerbla( "LAPACKE_dggsvd3_work", info ); + return info; + } + /* Query optimal working array(s) size if requested */ + if( lwork == -1 ) { + LAPACK_dggsvd3( &jobu, &jobv, &jobq, &m, &n, &p, k, l, a_t, &lda_t, + b_t, &ldb_t, alpha, beta, u_t, &ldu_t, v_t, &ldv_t, + q_t, &ldq_t, work, &lwork, iwork, &info ); + return (info < 0) ? (info - 1) : info; + } + /* Allocate memory for temporary array(s) */ + a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) ); + if( a_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_0; + } + b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,n) ); + if( b_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_1; + } + if( LAPACKE_lsame( jobu, 'u' ) ) { + u_t = (double*)LAPACKE_malloc( sizeof(double) * ldu_t * MAX(1,m) ); + if( u_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_2; + } + } + if( LAPACKE_lsame( jobv, 'v' ) ) { + v_t = (double*)LAPACKE_malloc( sizeof(double) * ldv_t * MAX(1,p) ); + if( v_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_3; + } + } + if( LAPACKE_lsame( jobq, 'q' ) ) { + q_t = (double*)LAPACKE_malloc( sizeof(double) * ldq_t * MAX(1,n) ); + if( q_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_4; + } + } + /* Transpose input matrices */ + LAPACKE_dge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + LAPACKE_dge_trans( matrix_layout, p, n, b, ldb, b_t, ldb_t ); + /* Call LAPACK function and adjust info */ + LAPACK_dggsvd3( &jobu, &jobv, &jobq, &m, &n, &p, k, l, a_t, &lda_t, b_t, + &ldb_t, alpha, beta, u_t, &ldu_t, v_t, &ldv_t, q_t, + &ldq_t, work, &lwork, iwork, &info ); + if( info < 0 ) { + info = info - 1; + } + /* Transpose output matrices */ + LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + LAPACKE_dge_trans( LAPACK_COL_MAJOR, p, n, b_t, ldb_t, b, ldb ); + if( LAPACKE_lsame( jobu, 'u' ) ) { + LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, m, u_t, ldu_t, u, ldu ); + } + if( LAPACKE_lsame( jobv, 'v' ) ) { + LAPACKE_dge_trans( LAPACK_COL_MAJOR, p, p, v_t, ldv_t, v, ldv ); + } + if( LAPACKE_lsame( jobq, 'q' ) ) { + LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); + } + /* Release memory and exit */ + if( LAPACKE_lsame( jobq, 'q' ) ) { + LAPACKE_free( q_t ); + } +exit_level_4: + if( LAPACKE_lsame( jobv, 'v' ) ) { + LAPACKE_free( v_t ); + } +exit_level_3: + if( LAPACKE_lsame( jobu, 'u' ) ) { + LAPACKE_free( u_t ); + } +exit_level_2: + LAPACKE_free( b_t ); +exit_level_1: + LAPACKE_free( a_t ); +exit_level_0: + if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_dggsvd3_work", info ); + } + } else { + info = -1; + LAPACKE_xerbla( "LAPACKE_dggsvd3_work", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_dggsvp3.c b/LAPACKE/src/lapacke_dggsvp3.c new file mode 100644 index 0000000..feb640c --- /dev/null +++ b/LAPACKE/src/lapacke_dggsvp3.c @@ -0,0 +1,107 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native high-level C interface to LAPACK function dggsvp3 +* Author: Intel Corporation +* Generated August, 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_dggsvp3( int matrix_layout, char jobu, char jobv, char jobq, + lapack_int m, lapack_int p, lapack_int n, double* a, + lapack_int lda, double* b, lapack_int ldb, + double tola, double tolb, lapack_int* k, + lapack_int* l, double* u, lapack_int ldu, double* v, + lapack_int ldv, double* q, lapack_int ldq ) +{ + lapack_int info = 0; + lapack_int* iwork = NULL; + double* tau = NULL; + double* work = NULL; + lapack_int lwork = -1; + double work_query; + if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { + LAPACKE_xerbla( "LAPACKE_dggsvp3", -1 ); + return -1; + } +#ifndef LAPACK_DISABLE_NAN_CHECK + /* Optionally check input matrices for NaNs */ + if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) { + return -8; + } + if( LAPACKE_dge_nancheck( matrix_layout, p, n, b, ldb ) ) { + return -10; + } + if( LAPACKE_d_nancheck( 1, &tola, 1 ) ) { + return -12; + } + if( LAPACKE_d_nancheck( 1, &tolb, 1 ) ) { + return -13; + } +#endif + /* Query optimal size for working array */ + info = LAPACKE_dggsvp3_work( matrix_layout, jobu, jobv, jobq, m, p, n, + a, lda, b, ldb, tola, tolb, k, l, u, ldu, + v, ldv, q, ldq, iwork, tau, &work_query, + lwork ); + if( info != 0 ) + goto exit_level_0; + lwork = work_query; + /* Allocate memory for working array(s) */ + iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n) ); + if( iwork == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_0; + } + tau = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,n) ); + if( tau == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_1; + } + work = (double*)LAPACKE_malloc( sizeof(double) * lwork ); + if( work == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_2; + } + /* Call middle-level interface */ + info = LAPACKE_dggsvp3_work( matrix_layout, jobu, jobv, jobq, m, p, n, a, lda, + b, ldb, tola, tolb, k, l, u, ldu, v, ldv, q, + ldq, iwork, tau, work, lwork ); + /* Release memory and exit */ + LAPACKE_free( work ); +exit_level_2: + LAPACKE_free( tau ); +exit_level_1: + LAPACKE_free( iwork ); +exit_level_0: + if( info == LAPACK_WORK_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_dggsvp3", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_dggsvp3_work.c b/LAPACKE/src/lapacke_dggsvp3_work.c new file mode 100644 index 0000000..e80a755 --- /dev/null +++ b/LAPACKE/src/lapacke_dggsvp3_work.c @@ -0,0 +1,178 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native middle-level C interface to LAPACK function dggsvp3 +* Author: Intel Corporation +* Generated August, 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_dggsvp3_work( int matrix_layout, char jobu, char jobv, + char jobq, lapack_int m, lapack_int p, + lapack_int n, double* a, lapack_int lda, + double* b, lapack_int ldb, double tola, + double tolb, lapack_int* k, lapack_int* l, + double* u, lapack_int ldu, double* v, + lapack_int ldv, double* q, lapack_int ldq, + lapack_int* iwork, double* tau, double* work, + lapack_int lwork ) +{ + lapack_int info = 0; + if( matrix_layout == LAPACK_COL_MAJOR ) { + /* Call LAPACK function and adjust info */ + LAPACK_dggsvp3( &jobu, &jobv, &jobq, &m, &p, &n, a, &lda, b, &ldb, &tola, + &tolb, k, l, u, &ldu, v, &ldv, q, &ldq, iwork, tau, work, + &lwork, &info ); + if( info < 0 ) { + info = info - 1; + } + } else if( matrix_layout == LAPACK_ROW_MAJOR ) { + lapack_int lda_t = MAX(1,m); + lapack_int ldb_t = MAX(1,p); + lapack_int ldq_t = MAX(1,n); + lapack_int ldu_t = MAX(1,m); + lapack_int ldv_t = MAX(1,p); + double* a_t = NULL; + double* b_t = NULL; + double* u_t = NULL; + double* v_t = NULL; + double* q_t = NULL; + /* Check leading dimension(s) */ + if( lda < n ) { + info = -9; + LAPACKE_xerbla( "LAPACKE_dggsvp3_work", info ); + return info; + } + if( ldb < n ) { + info = -11; + LAPACKE_xerbla( "LAPACKE_dggsvp3_work", info ); + return info; + } + if( ldq < n ) { + info = -21; + LAPACKE_xerbla( "LAPACKE_dggsvp3_work", info ); + return info; + } + if( ldu < m ) { + info = -17; + LAPACKE_xerbla( "LAPACKE_dggsvp3_work", info ); + return info; + } + if( ldv < m ) { + info = -19; + LAPACKE_xerbla( "LAPACKE_dggsvp3_work", info ); + return info; + } + if( lwork == -1 ) { + LAPACK_dggsvp3( &jobu, &jobv, &jobq, &m, &p, &n, a_t, &lda_t, b_t, + &ldb_t, &tola, &tolb, k, l, u_t, &ldu_t, v_t, + &ldv_t, q_t, &ldq_t, iwork, tau, work, &lwork, + &info ); + return (info < 0) ? (info - 1) : info; + } + /* Allocate memory for temporary array(s) */ + a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) ); + if( a_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_0; + } + b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,n) ); + if( b_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_1; + } + if( LAPACKE_lsame( jobu, 'u' ) ) { + u_t = (double*)LAPACKE_malloc( sizeof(double) * ldu_t * MAX(1,m) ); + if( u_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_2; + } + } + if( LAPACKE_lsame( jobv, 'v' ) ) { + v_t = (double*)LAPACKE_malloc( sizeof(double) * ldv_t * MAX(1,m) ); + if( v_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_3; + } + } + if( LAPACKE_lsame( jobq, 'q' ) ) { + q_t = (double*)LAPACKE_malloc( sizeof(double) * ldq_t * MAX(1,n) ); + if( q_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_4; + } + } + /* Transpose input matrices */ + LAPACKE_dge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + LAPACKE_dge_trans( matrix_layout, p, n, b, ldb, b_t, ldb_t ); + /* Call LAPACK function and adjust info */ + LAPACK_dggsvp3( &jobu, &jobv, &jobq, &m, &p, &n, a_t, &lda_t, b_t, + &ldb_t, &tola, &tolb, k, l, u_t, &ldu_t, v_t, &ldv_t, + q_t, &ldq_t, iwork, tau, work, &lwork, &info ); + if( info < 0 ) { + info = info - 1; + } + /* Transpose output matrices */ + LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + LAPACKE_dge_trans( LAPACK_COL_MAJOR, p, n, b_t, ldb_t, b, ldb ); + if( LAPACKE_lsame( jobu, 'u' ) ) { + LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, m, u_t, ldu_t, u, ldu ); + } + if( LAPACKE_lsame( jobv, 'v' ) ) { + LAPACKE_dge_trans( LAPACK_COL_MAJOR, p, m, v_t, ldv_t, v, ldv ); + } + if( LAPACKE_lsame( jobq, 'q' ) ) { + LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); + } + /* Release memory and exit */ + if( LAPACKE_lsame( jobq, 'q' ) ) { + LAPACKE_free( q_t ); + } +exit_level_4: + if( LAPACKE_lsame( jobv, 'v' ) ) { + LAPACKE_free( v_t ); + } +exit_level_3: + if( LAPACKE_lsame( jobu, 'u' ) ) { + LAPACKE_free( u_t ); + } +exit_level_2: + LAPACKE_free( b_t ); +exit_level_1: + LAPACKE_free( a_t ); +exit_level_0: + if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_dggsvp3_work", info ); + } + } else { + info = -1; + LAPACKE_xerbla( "LAPACKE_dggsvp3_work", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_sggsvd3.c b/LAPACKE/src/lapacke_sggsvd3.c new file mode 100644 index 0000000..5a2703a --- /dev/null +++ b/LAPACKE/src/lapacke_sggsvd3.c @@ -0,0 +1,85 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native high-level C interface to LAPACK function sggsvd3 +* Author: Intel Corporation +* Generated August, 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_sggsvd3( int matrix_layout, char jobu, char jobv, char jobq, + lapack_int m, lapack_int n, lapack_int p, + lapack_int* k, lapack_int* l, float* a, + lapack_int lda, float* b, lapack_int ldb, + float* alpha, float* beta, float* u, lapack_int ldu, + float* v, lapack_int ldv, float* q, lapack_int ldq, + lapack_int* iwork ) +{ + lapack_int info = 0; + float* work = NULL; + lapack_int lwork = -1; + float work_query; + if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { + LAPACKE_xerbla( "LAPACKE_sggsvd3", -1 ); + return -1; + } +#ifndef LAPACK_DISABLE_NAN_CHECK + /* Optionally check input matrices for NaNs */ + if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) { + return -10; + } + if( LAPACKE_sge_nancheck( matrix_layout, p, n, b, ldb ) ) { + return -12; + } +#endif + /* Query optimal working array(s) size if requested */ + info = LAPACKE_sggsvd3_work( matrix_layout, jobu, jobv, jobq, m, n, p, + k, l, a, lda, b, ldb, alpha, beta, u, ldu, + v, ldv, q, ldq, &work_query, lwork, iwork ); + if( info != 0 ) + goto exit_level_0; + lwork = work_query; + /* Allocate memory for working array(s) */ + work = (float*)LAPACKE_malloc( sizeof(float) * lwork ); + if( work == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_0; + } + /* Call middle-level interface */ + info = LAPACKE_sggsvd3_work( matrix_layout, jobu, jobv, jobq, m, n, p, k, l, + a, lda, b, ldb, alpha, beta, u, ldu, v, ldv, q, + ldq, work, lwork, iwork ); + /* Release memory and exit */ + LAPACKE_free( work ); +exit_level_0: + if( info == LAPACK_WORK_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_sggsvd3", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_sggsvd3_work.c b/LAPACKE/src/lapacke_sggsvd3_work.c new file mode 100644 index 0000000..617ecf2 --- /dev/null +++ b/LAPACKE/src/lapacke_sggsvd3_work.c @@ -0,0 +1,179 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native middle-level C interface to LAPACK function sggsvd3 +* Author: Intel Corporation +* Generated August, 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_sggsvd3_work( int matrix_layout, char jobu, char jobv, + char jobq, lapack_int m, lapack_int n, + lapack_int p, lapack_int* k, lapack_int* l, + float* a, lapack_int lda, float* b, + lapack_int ldb, float* alpha, float* beta, + float* u, lapack_int ldu, float* v, + lapack_int ldv, float* q, lapack_int ldq, + float* work, lapack_int lwork, + lapack_int* iwork ) +{ + lapack_int info = 0; + if( matrix_layout == LAPACK_COL_MAJOR ) { + /* Call LAPACK function and adjust info */ + LAPACK_sggsvd3( &jobu, &jobv, &jobq, &m, &n, &p, k, l, a, &lda, + b, &ldb, alpha, beta, u, &ldu, v, &ldv, q, &ldq, + work, &lwork, iwork, &info ); + if( info < 0 ) { + info = info - 1; + } + } else if( matrix_layout == LAPACK_ROW_MAJOR ) { + lapack_int lda_t = MAX(1,m); + lapack_int ldb_t = MAX(1,p); + lapack_int ldq_t = MAX(1,n); + lapack_int ldu_t = MAX(1,m); + lapack_int ldv_t = MAX(1,p); + float* a_t = NULL; + float* b_t = NULL; + float* u_t = NULL; + float* v_t = NULL; + float* q_t = NULL; + /* Check leading dimension(s) */ + if( lda < n ) { + info = -11; + LAPACKE_xerbla( "LAPACKE_sggsvd3_work", info ); + return info; + } + if( ldb < n ) { + info = -13; + LAPACKE_xerbla( "LAPACKE_sggsvd3_work", info ); + return info; + } + if( ldq < n ) { + info = -21; + LAPACKE_xerbla( "LAPACKE_sggsvd3_work", info ); + return info; + } + if( ldu < m ) { + info = -17; + LAPACKE_xerbla( "LAPACKE_sggsvd3_work", info ); + return info; + } + if( ldv < p ) { + info = -19; + LAPACKE_xerbla( "LAPACKE_sggsvd3_work", info ); + return info; + } + /* Query optimal working array(s) size if requested */ + if( lwork == -1 ) { + LAPACK_sggsvd3( &jobu, &jobv, &jobq, &m, &n, &p, k, l, a_t, &lda_t, + b_t, &ldb_t, alpha, beta, u_t, &ldu_t, v_t, &ldv_t, + q_t, &ldq_t, work, &lwork, iwork, &info ); + return (info < 0) ? (info - 1) : info; + } + + /* Allocate memory for temporary array(s) */ + a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) ); + if( a_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_0; + } + b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,n) ); + if( b_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_1; + } + if( LAPACKE_lsame( jobu, 'u' ) ) { + u_t = (float*)LAPACKE_malloc( sizeof(float) * ldu_t * MAX(1,m) ); + if( u_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_2; + } + } + if( LAPACKE_lsame( jobv, 'v' ) ) { + v_t = (float*)LAPACKE_malloc( sizeof(float) * ldv_t * MAX(1,p) ); + if( v_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_3; + } + } + if( LAPACKE_lsame( jobq, 'q' ) ) { + q_t = (float*)LAPACKE_malloc( sizeof(float) * ldq_t * MAX(1,n) ); + if( q_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_4; + } + } + /* Transpose input matrices */ + LAPACKE_sge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + LAPACKE_sge_trans( matrix_layout, p, n, b, ldb, b_t, ldb_t ); + /* Call LAPACK function and adjust info */ + LAPACK_sggsvd3( &jobu, &jobv, &jobq, &m, &n, &p, k, l, a_t, &lda_t, b_t, + &ldb_t, alpha, beta, u_t, &ldu_t, v_t, &ldv_t, q_t, + &ldq_t, work, &lwork, iwork, &info ); + if( info < 0 ) { + info = info - 1; + } + /* Transpose output matrices */ + LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + LAPACKE_sge_trans( LAPACK_COL_MAJOR, p, n, b_t, ldb_t, b, ldb ); + if( LAPACKE_lsame( jobu, 'u' ) ) { + LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, m, u_t, ldu_t, u, ldu ); + } + if( LAPACKE_lsame( jobv, 'v' ) ) { + LAPACKE_sge_trans( LAPACK_COL_MAJOR, p, p, v_t, ldv_t, v, ldv ); + } + if( LAPACKE_lsame( jobq, 'q' ) ) { + LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); + } + /* Release memory and exit */ + if( LAPACKE_lsame( jobq, 'q' ) ) { + LAPACKE_free( q_t ); + } +exit_level_4: + if( LAPACKE_lsame( jobv, 'v' ) ) { + LAPACKE_free( v_t ); + } +exit_level_3: + if( LAPACKE_lsame( jobu, 'u' ) ) { + LAPACKE_free( u_t ); + } +exit_level_2: + LAPACKE_free( b_t ); +exit_level_1: + LAPACKE_free( a_t ); +exit_level_0: + if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_sggsvd3_work", info ); + } + } else { + info = -1; + LAPACKE_xerbla( "LAPACKE_sggsvd3_work", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_sggsvp3.c b/LAPACKE/src/lapacke_sggsvp3.c new file mode 100644 index 0000000..1cb1d33 --- /dev/null +++ b/LAPACKE/src/lapacke_sggsvp3.c @@ -0,0 +1,107 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native high-level C interface to LAPACK function sggsvp3 +* Author: Intel Corporation +* Generated August, 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_sggsvp3( int matrix_layout, char jobu, char jobv, char jobq, + lapack_int m, lapack_int p, lapack_int n, float* a, + lapack_int lda, float* b, lapack_int ldb, float tola, + float tolb, lapack_int* k, lapack_int* l, float* u, + lapack_int ldu, float* v, lapack_int ldv, float* q, + lapack_int ldq ) +{ + lapack_int info = 0; + lapack_int* iwork = NULL; + float* tau = NULL; + float* work = NULL; + lapack_int lwork = -1; + float work_query; + if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { + LAPACKE_xerbla( "LAPACKE_sggsvp3", -1 ); + return -1; + } +#ifndef LAPACK_DISABLE_NAN_CHECK + /* Optionally check input matrices for NaNs */ + if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) { + return -8; + } + if( LAPACKE_sge_nancheck( matrix_layout, p, n, b, ldb ) ) { + return -10; + } + if( LAPACKE_s_nancheck( 1, &tola, 1 ) ) { + return -12; + } + if( LAPACKE_s_nancheck( 1, &tolb, 1 ) ) { + return -13; + } +#endif + /* Query optimal size for working array */ + info = LAPACKE_sggsvp3_work( matrix_layout, jobu, jobv, jobq, m, p, n, + a, lda, b, ldb, tola, tolb, k, l, u, ldu, + v, ldv, q, ldq, iwork, tau, &work_query, + lwork ); + if( info != 0 ) + goto exit_level_0; + lwork = work_query; + /* Allocate memory for working array(s) */ + iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n) ); + if( iwork == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_0; + } + tau = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,n) ); + if( tau == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_1; + } + work = (float*)LAPACKE_malloc( sizeof(float) * lwork ); + if( work == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_2; + } + /* Call middle-level interface */ + info = LAPACKE_sggsvp3_work( matrix_layout, jobu, jobv, jobq, m, p, n, a, lda, + b, ldb, tola, tolb, k, l, u, ldu, v, ldv, q, + ldq, iwork, tau, work, lwork ); + /* Release memory and exit */ + LAPACKE_free( work ); +exit_level_2: + LAPACKE_free( tau ); +exit_level_1: + LAPACKE_free( iwork ); +exit_level_0: + if( info == LAPACK_WORK_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_sggsvp3", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_sggsvp3_work.c b/LAPACKE/src/lapacke_sggsvp3_work.c new file mode 100644 index 0000000..ec200ca --- /dev/null +++ b/LAPACKE/src/lapacke_sggsvp3_work.c @@ -0,0 +1,179 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native middle-level C interface to LAPACK function sggsvp3 +* Author: Intel Corporation +* Generated August, 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_sggsvp3_work( int matrix_layout, char jobu, char jobv, + char jobq, lapack_int m, lapack_int p, + lapack_int n, float* a, lapack_int lda, + float* b, lapack_int ldb, float tola, + float tolb, lapack_int* k, lapack_int* l, + float* u, lapack_int ldu, float* v, + lapack_int ldv, float* q, lapack_int ldq, + lapack_int* iwork, float* tau, float* work, + lapack_int lwork ) +{ + lapack_int info = 0; + if( matrix_layout == LAPACK_COL_MAJOR ) { + /* Call LAPACK function and adjust info */ + LAPACK_sggsvp3( &jobu, &jobv, &jobq, &m, &p, &n, a, &lda, b, &ldb, &tola, + &tolb, k, l, u, &ldu, v, &ldv, q, &ldq, iwork, tau, work, + &lwork, &info ); + if( info < 0 ) { + info = info - 1; + } + } else if( matrix_layout == LAPACK_ROW_MAJOR ) { + lapack_int lda_t = MAX(1,m); + lapack_int ldb_t = MAX(1,p); + lapack_int ldq_t = MAX(1,n); + lapack_int ldu_t = MAX(1,m); + lapack_int ldv_t = MAX(1,p); + float* a_t = NULL; + float* b_t = NULL; + float* u_t = NULL; + float* v_t = NULL; + float* q_t = NULL; + /* Check leading dimension(s) */ + if( lda < n ) { + info = -9; + LAPACKE_xerbla( "LAPACKE_sggsvp3_work", info ); + return info; + } + if( ldb < n ) { + info = -11; + LAPACKE_xerbla( "LAPACKE_sggsvp3_work", info ); + return info; + } + if( ldq < n ) { + info = -21; + LAPACKE_xerbla( "LAPACKE_sggsvp3_work", info ); + return info; + } + if( ldu < m ) { + info = -17; + LAPACKE_xerbla( "LAPACKE_sggsvp3_work", info ); + return info; + } + if( ldv < m ) { + info = -19; + LAPACKE_xerbla( "LAPACKE_sggsvp3_work", info ); + return info; + } + /* Query optimal working array(s) size if requested */ + if( lwork == -1 ) { + LAPACK_sggsvp3( &jobu, &jobv, &jobq, &m, &p, &n, a_t, &lda_t, b_t, + &ldb_t, &tola, &tolb, k, l, u_t, &ldu_t, + v_t, &ldv_t, q_t, &ldq_t, iwork, tau, work, &lwork, + &info ); + return (info < 0) ? (info - 1) : info; + } + /* Allocate memory for temporary array(s) */ + a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) ); + if( a_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_0; + } + b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,n) ); + if( b_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_1; + } + if( LAPACKE_lsame( jobu, 'u' ) ) { + u_t = (float*)LAPACKE_malloc( sizeof(float) * ldu_t * MAX(1,m) ); + if( u_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_2; + } + } + if( LAPACKE_lsame( jobv, 'v' ) ) { + v_t = (float*)LAPACKE_malloc( sizeof(float) * ldv_t * MAX(1,m) ); + if( v_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_3; + } + } + if( LAPACKE_lsame( jobq, 'q' ) ) { + q_t = (float*)LAPACKE_malloc( sizeof(float) * ldq_t * MAX(1,n) ); + if( q_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_4; + } + } + /* Transpose input matrices */ + LAPACKE_sge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + LAPACKE_sge_trans( matrix_layout, p, n, b, ldb, b_t, ldb_t ); + /* Call LAPACK function and adjust info */ + LAPACK_sggsvp3( &jobu, &jobv, &jobq, &m, &p, &n, a_t, &lda_t, b_t, + &ldb_t, &tola, &tolb, k, l, u_t, &ldu_t, v_t, &ldv_t, + q_t, &ldq_t, iwork, tau, work, &lwork, &info ); + if( info < 0 ) { + info = info - 1; + } + /* Transpose output matrices */ + LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + LAPACKE_sge_trans( LAPACK_COL_MAJOR, p, n, b_t, ldb_t, b, ldb ); + if( LAPACKE_lsame( jobu, 'u' ) ) { + LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, m, u_t, ldu_t, u, ldu ); + } + if( LAPACKE_lsame( jobv, 'v' ) ) { + LAPACKE_sge_trans( LAPACK_COL_MAJOR, p, m, v_t, ldv_t, v, ldv ); + } + if( LAPACKE_lsame( jobq, 'q' ) ) { + LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); + } + /* Release memory and exit */ + if( LAPACKE_lsame( jobq, 'q' ) ) { + LAPACKE_free( q_t ); + } +exit_level_4: + if( LAPACKE_lsame( jobv, 'v' ) ) { + LAPACKE_free( v_t ); + } +exit_level_3: + if( LAPACKE_lsame( jobu, 'u' ) ) { + LAPACKE_free( u_t ); + } +exit_level_2: + LAPACKE_free( b_t ); +exit_level_1: + LAPACKE_free( a_t ); +exit_level_0: + if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_sggsvp3_work", info ); + } + } else { + info = -1; + LAPACKE_xerbla( "LAPACKE_sggsvp3_work", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_zggsvd3.c b/LAPACKE/src/lapacke_zggsvd3.c new file mode 100644 index 0000000..e274fe0 --- /dev/null +++ b/LAPACKE/src/lapacke_zggsvd3.c @@ -0,0 +1,97 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native high-level C interface to LAPACK function zggsvd3 +* Author: Intel Corporation +* Generated August, 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_zggsvd3( int matrix_layout, char jobu, char jobv, char jobq, + lapack_int m, lapack_int n, lapack_int p, + lapack_int* k, lapack_int* l, + lapack_complex_double* a, lapack_int lda, + lapack_complex_double* b, lapack_int ldb, + double* alpha, double* beta, + lapack_complex_double* u, lapack_int ldu, + lapack_complex_double* v, lapack_int ldv, + lapack_complex_double* q, lapack_int ldq, + lapack_int* iwork ) +{ + lapack_int info = 0; + double* rwork = NULL; + lapack_int lwork = -1; + lapack_complex_double* work = NULL; + lapack_complex_double work_query; + if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { + LAPACKE_xerbla( "LAPACKE_zggsvd3", -1 ); + return -1; + } +#ifndef LAPACK_DISABLE_NAN_CHECK + /* Optionally check input matrices for NaNs */ + if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) { + return -10; + } + if( LAPACKE_zge_nancheck( matrix_layout, p, n, b, ldb ) ) { + return -12; + } +#endif + /* Query optimal size for working array */ + info = LAPACKE_zggsvd3_work( matrix_layout, jobu, jobv, jobq, m, n, p, k, l, + a, lda, b, ldb, alpha, beta, u, ldu, v, ldv, q, + ldq, &work_query, lwork, rwork, iwork ); + if( info != 0 ) + goto exit_level_0; + lwork = LAPACK_Z2INT( work_query ); + /* Allocate memory for working array(s) */ + rwork = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,2*n) ); + if( rwork == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_0; + } + work = (lapack_complex_double*) + LAPACKE_malloc( sizeof(lapack_complex_double) * lwork ); + if( work == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_1; + } + /* Call middle-level interface */ + info = LAPACKE_zggsvd3_work( matrix_layout, jobu, jobv, jobq, m, n, p, k, l, + a, lda, b, ldb, alpha, beta, u, ldu, v, ldv, q, + ldq, work, lwork, rwork, iwork ); + /* Release memory and exit */ + LAPACKE_free( work ); +exit_level_1: + LAPACKE_free( rwork ); +exit_level_0: + if( info == LAPACK_WORK_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_zggsvd3", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_zggsvd3_work.c b/LAPACKE/src/lapacke_zggsvd3_work.c new file mode 100644 index 0000000..aedd405 --- /dev/null +++ b/LAPACKE/src/lapacke_zggsvd3_work.c @@ -0,0 +1,188 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native middle-level C interface to LAPACK function zggsvd3 +* Author: Intel Corporation +* Generated August, 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_zggsvd3_work( int matrix_layout, char jobu, char jobv, + char jobq, lapack_int m, lapack_int n, + lapack_int p, lapack_int* k, lapack_int* l, + lapack_complex_double* a, lapack_int lda, + lapack_complex_double* b, lapack_int ldb, + double* alpha, double* beta, + lapack_complex_double* u, lapack_int ldu, + lapack_complex_double* v, lapack_int ldv, + lapack_complex_double* q, lapack_int ldq, + lapack_complex_double* work, lapack_int lwork, + double* rwork, lapack_int* iwork ) +{ + lapack_int info = 0; + if( matrix_layout == LAPACK_COL_MAJOR ) { + /* Call LAPACK function and adjust info */ + LAPACK_zggsvd3( &jobu, &jobv, &jobq, &m, &n, &p, k, l, a, &lda, b, &ldb, + alpha, beta, u, &ldu, v, &ldv, q, &ldq, work, &lwork, + rwork, iwork, &info ); + if( info < 0 ) { + info = info - 1; + } + } else if( matrix_layout == LAPACK_ROW_MAJOR ) { + lapack_int lda_t = MAX(1,m); + lapack_int ldb_t = MAX(1,p); + lapack_int ldq_t = MAX(1,n); + lapack_int ldu_t = MAX(1,m); + lapack_int ldv_t = MAX(1,p); + lapack_complex_double* a_t = NULL; + lapack_complex_double* b_t = NULL; + lapack_complex_double* u_t = NULL; + lapack_complex_double* v_t = NULL; + lapack_complex_double* q_t = NULL; + /* Check leading dimension(s) */ + if( lda < n ) { + info = -11; + LAPACKE_xerbla( "LAPACKE_zggsvd3_work", info ); + return info; + } + if( ldb < n ) { + info = -13; + LAPACKE_xerbla( "LAPACKE_zggsvd3_work", info ); + return info; + } + if( ldq < n ) { + info = -21; + LAPACKE_xerbla( "LAPACKE_zggsvd3_work", info ); + return info; + } + if( ldu < m ) { + info = -17; + LAPACKE_xerbla( "LAPACKE_zggsvd3_work", info ); + return info; + } + if( ldv < p ) { + info = -19; + LAPACKE_xerbla( "LAPACKE_zggsvd3_work", info ); + return info; + } + /* Query optimal working array(s) size if requested */ + if( lwork == -1 ) { + LAPACK_zggsvd3( &jobu, &jobv, &jobq, &m, &n, &p, k, l, a_t, &lda_t, + b_t, &ldb_t, alpha, beta, u_t, &ldu_t, v_t, &ldv_t, + q_t, &ldq_t, work, &lwork, rwork, iwork, &info ); + return (info < 0) ? (info - 1) : info; + } + /* Allocate memory for temporary array(s) */ + a_t = (lapack_complex_double*) + LAPACKE_malloc( sizeof(lapack_complex_double) * lda_t * MAX(1,n) ); + if( a_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_0; + } + b_t = (lapack_complex_double*) + LAPACKE_malloc( sizeof(lapack_complex_double) * ldb_t * MAX(1,n) ); + if( b_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_1; + } + if( LAPACKE_lsame( jobu, 'u' ) ) { + u_t = (lapack_complex_double*) + LAPACKE_malloc( sizeof(lapack_complex_double) * + ldu_t * MAX(1,m) ); + if( u_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_2; + } + } + if( LAPACKE_lsame( jobv, 'v' ) ) { + v_t = (lapack_complex_double*) + LAPACKE_malloc( sizeof(lapack_complex_double) * + ldv_t * MAX(1,p) ); + if( v_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_3; + } + } + if( LAPACKE_lsame( jobq, 'q' ) ) { + q_t = (lapack_complex_double*) + LAPACKE_malloc( sizeof(lapack_complex_double) * + ldq_t * MAX(1,n) ); + if( q_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_4; + } + } + /* Transpose input matrices */ + LAPACKE_zge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + LAPACKE_zge_trans( matrix_layout, p, n, b, ldb, b_t, ldb_t ); + /* Call LAPACK function and adjust info */ + LAPACK_zggsvd3( &jobu, &jobv, &jobq, &m, &n, &p, k, l, a_t, &lda_t, b_t, + &ldb_t, alpha, beta, u_t, &ldu_t, v_t, &ldv_t, q_t, + &ldq_t, work, &lwork, rwork, iwork, &info ); + if( info < 0 ) { + info = info - 1; + } + /* Transpose output matrices */ + LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + LAPACKE_zge_trans( LAPACK_COL_MAJOR, p, n, b_t, ldb_t, b, ldb ); + if( LAPACKE_lsame( jobu, 'u' ) ) { + LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, m, u_t, ldu_t, u, ldu ); + } + if( LAPACKE_lsame( jobv, 'v' ) ) { + LAPACKE_zge_trans( LAPACK_COL_MAJOR, p, p, v_t, ldv_t, v, ldv ); + } + if( LAPACKE_lsame( jobq, 'q' ) ) { + LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); + } + /* Release memory and exit */ + if( LAPACKE_lsame( jobq, 'q' ) ) { + LAPACKE_free( q_t ); + } +exit_level_4: + if( LAPACKE_lsame( jobv, 'v' ) ) { + LAPACKE_free( v_t ); + } +exit_level_3: + if( LAPACKE_lsame( jobu, 'u' ) ) { + LAPACKE_free( u_t ); + } +exit_level_2: + LAPACKE_free( b_t ); +exit_level_1: + LAPACKE_free( a_t ); +exit_level_0: + if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_zggsvd3_work", info ); + } + } else { + info = -1; + LAPACKE_xerbla( "LAPACKE_zggsvd3_work", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_zggsvp3.c b/LAPACKE/src/lapacke_zggsvp3.c new file mode 100644 index 0000000..d853f7d --- /dev/null +++ b/LAPACKE/src/lapacke_zggsvp3.c @@ -0,0 +1,119 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native high-level C interface to LAPACK function zggsvp3 +* Author: Intel Corporation +* Generated August, 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_zggsvp3( int matrix_layout, char jobu, char jobv, char jobq, + lapack_int m, lapack_int p, lapack_int n, + lapack_complex_double* a, lapack_int lda, + lapack_complex_double* b, lapack_int ldb, + double tola, double tolb, lapack_int* k, + lapack_int* l, lapack_complex_double* u, + lapack_int ldu, lapack_complex_double* v, + lapack_int ldv, lapack_complex_double* q, + lapack_int ldq ) +{ + lapack_int info = 0; + lapack_int* iwork = NULL; + double* rwork = NULL; + lapack_complex_double* tau = NULL; + lapack_complex_double* work = NULL; + lapack_int lwork = -1; + lapack_complex_double work_query; + if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { + LAPACKE_xerbla( "LAPACKE_zggsvp3", -1 ); + return -1; + } +#ifndef LAPACK_DISABLE_NAN_CHECK + /* Optionally check input matrices for NaNs */ + if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) { + return -8; + } + if( LAPACKE_zge_nancheck( matrix_layout, p, n, b, ldb ) ) { + return -10; + } + if( LAPACKE_d_nancheck( 1, &tola, 1 ) ) { + return -12; + } + if( LAPACKE_d_nancheck( 1, &tolb, 1 ) ) { + return -13; + } +#endif + /* Query optimal size for working array */ + info = LAPACKE_zggsvp3_work( matrix_layout, jobu, jobv, jobq, m, p, n, a, lda, + b, ldb, tola, tolb, k, l, u, ldu, v, ldv, q, + ldq, iwork, rwork, tau, &work_query, lwork ); + if( info != 0 ) + goto exit_level_0; + lwork = LAPACK_Z2INT( work_query ); + /* Allocate memory for working array(s) */ + iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n) ); + if( iwork == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_0; + } + rwork = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,2*n) ); + if( rwork == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_1; + } + tau = (lapack_complex_double*) + LAPACKE_malloc( sizeof(lapack_complex_double) * MAX(1,n) ); + if( tau == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_2; + } + work = (lapack_complex_double*) + LAPACKE_malloc( sizeof(lapack_complex_double) * lwork ); + if( work == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_3; + } + /* Call middle-level interface */ + info = LAPACKE_zggsvp3_work( matrix_layout, jobu, jobv, jobq, m, p, n, a, lda, + b, ldb, tola, tolb, k, l, u, ldu, v, ldv, q, + ldq, iwork, rwork, tau, work, lwork ); + /* Release memory and exit */ + LAPACKE_free( work ); +exit_level_3: + LAPACKE_free( tau ); +exit_level_2: + LAPACKE_free( rwork ); +exit_level_1: + LAPACKE_free( iwork ); +exit_level_0: + if( info == LAPACK_WORK_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_zggsvp3", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_zggsvp3_work.c b/LAPACKE/src/lapacke_zggsvp3_work.c new file mode 100644 index 0000000..a266beb --- /dev/null +++ b/LAPACKE/src/lapacke_zggsvp3_work.c @@ -0,0 +1,190 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native middle-level C interface to LAPACK function zggsvp3 +* Author: Intel Corporation +* Generated August, 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_zggsvp3_work( int matrix_layout, char jobu, char jobv, + char jobq, lapack_int m, lapack_int p, + lapack_int n, lapack_complex_double* a, + lapack_int lda, lapack_complex_double* b, + lapack_int ldb, double tola, double tolb, + lapack_int* k, lapack_int* l, + lapack_complex_double* u, lapack_int ldu, + lapack_complex_double* v, lapack_int ldv, + lapack_complex_double* q, lapack_int ldq, + lapack_int* iwork, double* rwork, + lapack_complex_double* tau, + lapack_complex_double* work, lapack_int lwork ) +{ + lapack_int info = 0; + if( matrix_layout == LAPACK_COL_MAJOR ) { + /* Call LAPACK function and adjust info */ + LAPACK_zggsvp3( &jobu, &jobv, &jobq, &m, &p, &n, a, &lda, b, &ldb, &tola, + &tolb, k, l, u, &ldu, v, &ldv, q, &ldq, iwork, rwork, + tau, work, &lwork, &info ); + if( info < 0 ) { + info = info - 1; + } + } else if( matrix_layout == LAPACK_ROW_MAJOR ) { + lapack_int lda_t = MAX(1,m); + lapack_int ldb_t = MAX(1,p); + lapack_int ldq_t = MAX(1,n); + lapack_int ldu_t = MAX(1,m); + lapack_int ldv_t = MAX(1,p); + lapack_complex_double* a_t = NULL; + lapack_complex_double* b_t = NULL; + lapack_complex_double* u_t = NULL; + lapack_complex_double* v_t = NULL; + lapack_complex_double* q_t = NULL; + /* Check leading dimension(s) */ + if( lda < n ) { + info = -9; + LAPACKE_xerbla( "LAPACKE_zggsvp3_work", info ); + return info; + } + if( ldb < n ) { + info = -11; + LAPACKE_xerbla( "LAPACKE_zggsvp3_work", info ); + return info; + } + if( ldq < n ) { + info = -21; + LAPACKE_xerbla( "LAPACKE_zggsvp3_work", info ); + return info; + } + if( ldu < m ) { + info = -17; + LAPACKE_xerbla( "LAPACKE_zggsvp3_work", info ); + return info; + } + if( ldv < m ) { + info = -19; + LAPACKE_xerbla( "LAPACKE_zggsvp3_work", info ); + return info; + } + /* Query optimal working array(s) size if requested */ + if( lwork == -1 ) { + LAPACK_zggsvp3( &jobu, &jobv, &jobq, &m, &p, &n, a_t, &lda_t, b_t, + &ldb_t, &tola, &tolb, k, l, u_t, &ldu_t, v_t, + &ldv_t, q_t, &ldq_t, iwork, rwork, tau, work, + &lwork, &info ); + return (info < 0) ? (info - 1) : info; + } + /* Allocate memory for temporary array(s) */ + a_t = (lapack_complex_double*) + LAPACKE_malloc( sizeof(lapack_complex_double) * lda_t * MAX(1,n) ); + if( a_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_0; + } + b_t = (lapack_complex_double*) + LAPACKE_malloc( sizeof(lapack_complex_double) * ldb_t * MAX(1,n) ); + if( b_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_1; + } + if( LAPACKE_lsame( jobu, 'u' ) ) { + u_t = (lapack_complex_double*) + LAPACKE_malloc( sizeof(lapack_complex_double) * + ldu_t * MAX(1,m) ); + if( u_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_2; + } + } + if( LAPACKE_lsame( jobv, 'v' ) ) { + v_t = (lapack_complex_double*) + LAPACKE_malloc( sizeof(lapack_complex_double) * + ldv_t * MAX(1,m) ); + if( v_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_3; + } + } + if( LAPACKE_lsame( jobq, 'q' ) ) { + q_t = (lapack_complex_double*) + LAPACKE_malloc( sizeof(lapack_complex_double) * + ldq_t * MAX(1,n) ); + if( q_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_4; + } + } + /* Transpose input matrices */ + LAPACKE_zge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + LAPACKE_zge_trans( matrix_layout, p, n, b, ldb, b_t, ldb_t ); + /* Call LAPACK function and adjust info */ + LAPACK_zggsvp3( &jobu, &jobv, &jobq, &m, &p, &n, a_t, &lda_t, b_t, + &ldb_t, &tola, &tolb, k, l, u_t, &ldu_t, v_t, &ldv_t, + q_t, &ldq_t, iwork, rwork, tau, work, &lwork, &info ); + if( info < 0 ) { + info = info - 1; + } + /* Transpose output matrices */ + LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + LAPACKE_zge_trans( LAPACK_COL_MAJOR, p, n, b_t, ldb_t, b, ldb ); + if( LAPACKE_lsame( jobu, 'u' ) ) { + LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, m, u_t, ldu_t, u, ldu ); + } + if( LAPACKE_lsame( jobv, 'v' ) ) { + LAPACKE_zge_trans( LAPACK_COL_MAJOR, p, m, v_t, ldv_t, v, ldv ); + } + if( LAPACKE_lsame( jobq, 'q' ) ) { + LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); + } + /* Release memory and exit */ + if( LAPACKE_lsame( jobq, 'q' ) ) { + LAPACKE_free( q_t ); + } +exit_level_4: + if( LAPACKE_lsame( jobv, 'v' ) ) { + LAPACKE_free( v_t ); + } +exit_level_3: + if( LAPACKE_lsame( jobu, 'u' ) ) { + LAPACKE_free( u_t ); + } +exit_level_2: + LAPACKE_free( b_t ); +exit_level_1: + LAPACKE_free( a_t ); +exit_level_0: + if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_zggsvp3_work", info ); + } + } else { + info = -1; + LAPACKE_xerbla( "LAPACKE_zggsvp3_work", info ); + } + return info; +} -- 2.7.4