diff options
author | eugene.chereshnev <echeresh@mandrake.jf.intel.com> | 2016-12-12 23:34:34 -0800 |
---|---|---|
committer | eugene.chereshnev <echeresh@mandrake.jf.intel.com> | 2016-12-13 22:29:23 -0800 |
commit | 5143bb56b2c5e7ef6f63e411714e57c612931bce (patch) | |
tree | b31c0435d199047d0ee518334614bef0df93daba | |
parent | d6b3d2f59568035e4322cd7c65c8819916868b1f (diff) | |
download | lapack-5143bb56b2c5e7ef6f63e411714e57c612931bce.tar.gz lapack-5143bb56b2c5e7ef6f63e411714e57c612931bce.tar.bz2 lapack-5143bb56b2c5e7ef6f63e411714e57c612931bce.zip |
Add lapacke interfaces for ?getsls
-rw-r--r-- | LAPACKE/include/lapacke.h | 123 | ||||
-rw-r--r-- | LAPACKE/src/CMakeLists.txt | 8 | ||||
-rw-r--r-- | LAPACKE/src/Makefile | 8 | ||||
-rw-r--r-- | LAPACKE/src/lapacke_cgetsls.c | 82 | ||||
-rw-r--r-- | LAPACKE/src/lapacke_cgetsls_work.c | 112 | ||||
-rw-r--r-- | LAPACKE/src/lapacke_dgetsls.c | 80 | ||||
-rw-r--r-- | LAPACKE/src/lapacke_dgetsls_work.c | 108 | ||||
-rw-r--r-- | LAPACKE/src/lapacke_sgetsls.c | 80 | ||||
-rw-r--r-- | LAPACKE/src/lapacke_sgetsls_work.c | 108 | ||||
-rw-r--r-- | LAPACKE/src/lapacke_zgetsls.c | 82 | ||||
-rw-r--r-- | LAPACKE/src/lapacke_zgetsls_work.c | 112 |
11 files changed, 903 insertions, 0 deletions
diff --git a/LAPACKE/include/lapacke.h b/LAPACKE/include/lapacke.h index cb91e42e..d43c6c6b 100644 --- a/LAPACKE/include/lapacke.h +++ b/LAPACKE/include/lapacke.h @@ -11815,6 +11815,19 @@ lapack_int LAPACKE_zhecon_3_work( int matrix_layout, char uplo, lapack_int n, const lapack_int* ipiv, double anorm, double* rcond, lapack_complex_double* work ); +lapack_int LAPACKE_sgelq( int matrix_layout, lapack_int m, lapack_int n, + float* a, lapack_int lda, + float* t, lapack_int tsize ); +lapack_int LAPACKE_dgelq( int matrix_layout, lapack_int m, lapack_int n, + double* a, lapack_int lda, + double* t, lapack_int tsize ); +lapack_int LAPACKE_cgelq( int matrix_layout, lapack_int m, lapack_int n, + lapack_complex_float* a, lapack_int lda, + lapack_complex_float* t, lapack_int tsize ); +lapack_int LAPACKE_zgelq( int matrix_layout, lapack_int m, lapack_int n, + lapack_complex_double* a, lapack_int lda, + lapack_complex_double* t, lapack_int tsize ); + lapack_int LAPACKE_sgelq_work( int matrix_layout, lapack_int m, lapack_int n, float* a, lapack_int lda, float* t, lapack_int tsize, @@ -11832,6 +11845,27 @@ lapack_int LAPACKE_zgelq_work( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_double* t, lapack_int tsize, lapack_complex_double* work, lapack_int lwork ); +lapack_int LAPACKE_sgemlq( int matrix_layout, char side, char trans, + lapack_int m, lapack_int n, lapack_int k, + const float* a, lapack_int lda, + const float* t, lapack_int tsize, + float* c, lapack_int ldc ); +lapack_int LAPACKE_dgemlq( int matrix_layout, char side, char trans, + lapack_int m, lapack_int n, lapack_int k, + const double* a, lapack_int lda, + const double* t, lapack_int tsize, + double* c, lapack_int ldc ); +lapack_int LAPACKE_cgemlq( int matrix_layout, char side, char trans, + lapack_int m, lapack_int n, lapack_int k, + const lapack_complex_float* a, lapack_int lda, + const lapack_complex_float* t, lapack_int tsize, + lapack_complex_float* c, lapack_int ldc ); +lapack_int LAPACKE_zgemlq( int matrix_layout, char side, char trans, + lapack_int m, lapack_int n, lapack_int k, + const lapack_complex_double* a, lapack_int lda, + const lapack_complex_double* t, lapack_int tsize, + lapack_complex_double* c, lapack_int ldc ); + lapack_int LAPACKE_sgemlq_work( int matrix_layout, char side, char trans, lapack_int m, lapack_int n, lapack_int k, const float* a, lapack_int lda, @@ -11857,6 +11891,19 @@ lapack_int LAPACKE_zgemlq_work( int matrix_layout, char side, char trans, lapack_complex_double* c, lapack_int ldc, lapack_complex_double* work, lapack_int lwork ); +lapack_int LAPACKE_sgeqr( int matrix_layout, lapack_int m, lapack_int n, + float* a, lapack_int lda, + float* t, lapack_int tsize ); +lapack_int LAPACKE_dgeqr( int matrix_layout, lapack_int m, lapack_int n, + double* a, lapack_int lda, + double* t, lapack_int tsize ); +lapack_int LAPACKE_cgeqr( int matrix_layout, lapack_int m, lapack_int n, + lapack_complex_float* a, lapack_int lda, + lapack_complex_float* t, lapack_int tsize ); +lapack_int LAPACKE_zgeqr( int matrix_layout, lapack_int m, lapack_int n, + lapack_complex_double* a, lapack_int lda, + lapack_complex_double* t, lapack_int tsize ); + lapack_int LAPACKE_sgeqr_work( int matrix_layout, lapack_int m, lapack_int n, float* a, lapack_int lda, float* t, lapack_int tsize, @@ -11874,6 +11921,27 @@ lapack_int LAPACKE_zgeqr_work( int matrix_layout, lapack_int m, lapack_int n, lapack_complex_double* t, lapack_int tsize, lapack_complex_double* work, lapack_int lwork ); +lapack_int LAPACKE_sgemqr( int matrix_layout, char side, char trans, + lapack_int m, lapack_int n, lapack_int k, + const float* a, lapack_int lda, + const float* t, lapack_int tsize, + float* c, lapack_int ldc ); +lapack_int LAPACKE_dgemqr( int matrix_layout, char side, char trans, + lapack_int m, lapack_int n, lapack_int k, + const double* a, lapack_int lda, + const double* t, lapack_int tsize, + double* c, lapack_int ldc ); +lapack_int LAPACKE_cgemqr( int matrix_layout, char side, char trans, + lapack_int m, lapack_int n, lapack_int k, + const lapack_complex_float* a, lapack_int lda, + const lapack_complex_float* t, lapack_int tsize, + lapack_complex_float* c, lapack_int ldc ); +lapack_int LAPACKE_zgemqr( int matrix_layout, char side, char trans, + lapack_int m, lapack_int n, lapack_int k, + const lapack_complex_double* a, lapack_int lda, + const lapack_complex_double* t, lapack_int tsize, + lapack_complex_double* c, lapack_int ldc ); + lapack_int LAPACKE_sgemqr_work( int matrix_layout, char side, char trans, lapack_int m, lapack_int n, lapack_int k, const float* a, lapack_int lda, @@ -11899,6 +11967,40 @@ lapack_int LAPACKE_zgemqr_work( int matrix_layout, char side, char trans, lapack_complex_double* c, lapack_int ldc, lapack_complex_double* work, lapack_int lwork ); +lapack_int LAPACKE_sgetsls( int matrix_layout, char trans, lapack_int m, + lapack_int n, lapack_int nrhs, float* a, + lapack_int lda, float* b, lapack_int ldb ); +lapack_int LAPACKE_dgetsls( int matrix_layout, char trans, lapack_int m, + lapack_int n, lapack_int nrhs, double* a, + lapack_int lda, double* b, lapack_int ldb ); +lapack_int LAPACKE_cgetsls( int matrix_layout, char trans, lapack_int m, + lapack_int n, lapack_int nrhs, + lapack_complex_float* a, lapack_int lda, + lapack_complex_float* b, lapack_int ldb ); +lapack_int LAPACKE_zgetsls( int matrix_layout, char trans, lapack_int m, + lapack_int n, lapack_int nrhs, + lapack_complex_double* a, lapack_int lda, + lapack_complex_double* b, lapack_int ldb ); + +lapack_int LAPACKE_sgetsls_work( int matrix_layout, char trans, lapack_int m, + lapack_int n, lapack_int nrhs, float* a, + lapack_int lda, float* b, lapack_int ldb, + float* work, lapack_int lwork ); +lapack_int LAPACKE_dgetsls_work( int matrix_layout, char trans, lapack_int m, + lapack_int n, lapack_int nrhs, double* a, + lapack_int lda, double* b, lapack_int ldb, + double* work, lapack_int lwork ); +lapack_int LAPACKE_cgetsls_work( int matrix_layout, char trans, lapack_int m, + lapack_int n, lapack_int nrhs, + lapack_complex_float* a, lapack_int lda, + lapack_complex_float* b, lapack_int ldb, + lapack_complex_float* work, lapack_int lwork ); +lapack_int LAPACKE_zgetsls_work( int matrix_layout, char trans, lapack_int m, + lapack_int n, lapack_int nrhs, + lapack_complex_double* a, lapack_int lda, + lapack_complex_double* b, lapack_int ldb, + lapack_complex_double* work, lapack_int lwork ); + #define LAPACK_sgetrf LAPACK_GLOBAL(sgetrf,SGETRF) #define LAPACK_dgetrf LAPACK_GLOBAL(dgetrf,DGETRF) #define LAPACK_cgetrf LAPACK_GLOBAL(cgetrf,CGETRF) @@ -13072,6 +13174,10 @@ lapack_int LAPACKE_zgemqr_work( int matrix_layout, char side, char trans, #define LAPACK_dgemqr LAPACK_GLOBAL(dgemqr,DGEMQR) #define LAPACK_cgemqr LAPACK_GLOBAL(cgemqr,CGEMQR) #define LAPACK_zgemqr LAPACK_GLOBAL(zgemqr,ZGEMQR) +#define LAPACK_sgetsls LAPACK_GLOBAL(sgetsls,SGETSLS) +#define LAPACK_dgetsls LAPACK_GLOBAL(dgetsls,DGETSLS) +#define LAPACK_cgetsls LAPACK_GLOBAL(cgetsls,CGETSLS) +#define LAPACK_zgetsls LAPACK_GLOBAL(zgetsls,ZGETSLS) void LAPACK_sgetrf( lapack_int* m, lapack_int* n, float* a, lapack_int* lda, @@ -18370,6 +18476,23 @@ void LAPACK_zgemqr( char* side, char* trans, lapack_int* m, lapack_int* n, lapac lapack_complex_double* work, lapack_int* lwork, lapack_int* info ); +void LAPACK_sgetsls( char* trans, lapack_int* m, lapack_int* n, lapack_int* nrhs, + float* a, lapack_int* lda, float* b, lapack_int* ldb, + float* work, lapack_int* lwork, lapack_int *info ); +void LAPACK_dgetsls( char* trans, lapack_int* m, lapack_int* n, lapack_int* nrhs, + double* a, lapack_int* lda, double* b, lapack_int* ldb, + double* work, lapack_int* lwork, lapack_int *info ); +void LAPACK_cgetsls( char* trans, lapack_int* m, lapack_int* n, lapack_int* nrhs, + lapack_complex_float* a, lapack_int* lda, + lapack_complex_float* b, lapack_int* ldb, + lapack_complex_float* work, lapack_int* lwork, + lapack_int *info ); +void LAPACK_zgetsls( char* trans, lapack_int* m, lapack_int* n, lapack_int* nrhs, + lapack_complex_double* a, lapack_int* lda, + lapack_complex_double* b, lapack_int* ldb, + lapack_complex_double* work, lapack_int* lwork, + lapack_int *info ); + #ifdef __cplusplus } #endif /* __cplusplus */ diff --git a/LAPACKE/src/CMakeLists.txt b/LAPACKE/src/CMakeLists.txt index ffceb1a3..0f5b0baf 100644 --- a/LAPACKE/src/CMakeLists.txt +++ b/LAPACKE/src/CMakeLists.txt @@ -105,6 +105,8 @@ lapacke_cgetri.c lapacke_cgetri_work.c lapacke_cgetrs.c lapacke_cgetrs_work.c +lapacke_cgetsls.c +lapacke_cgetsls_work.c lapacke_cggbak.c lapacke_cggbak_work.c lapacke_cggbal.c @@ -671,6 +673,8 @@ lapacke_dgetri.c lapacke_dgetri_work.c lapacke_dgetrs.c lapacke_dgetrs_work.c +lapacke_dgetsls.c +lapacke_dgetsls_work.c lapacke_dggbak.c lapacke_dggbak_work.c lapacke_dggbal.c @@ -1201,6 +1205,8 @@ lapacke_sgetri.c lapacke_sgetri_work.c lapacke_sgetrs.c lapacke_sgetrs_work.c +lapacke_sgetsls.c +lapacke_sgetsls_work.c lapacke_sggbak.c lapacke_sggbak_work.c lapacke_sggbal.c @@ -1725,6 +1731,8 @@ lapacke_zgetri.c lapacke_zgetri_work.c lapacke_zgetrs.c lapacke_zgetrs_work.c +lapacke_zgetsls.c +lapacke_zgetsls_work.c lapacke_zggbak.c lapacke_zggbak_work.c lapacke_zggbal.c diff --git a/LAPACKE/src/Makefile b/LAPACKE/src/Makefile index 9805c001..f32be2ee 100644 --- a/LAPACKE/src/Makefile +++ b/LAPACKE/src/Makefile @@ -139,6 +139,8 @@ lapacke_cgetri.o \ lapacke_cgetri_work.o \ lapacke_cgetrs.o \ lapacke_cgetrs_work.o \ +lapacke_cgetsls.o \ +lapacke_cgetsls_work.o \ lapacke_cggbak.o \ lapacke_cggbak_work.o \ lapacke_cggbal.o \ @@ -705,6 +707,8 @@ lapacke_dgetri.o \ lapacke_dgetri_work.o \ lapacke_dgetrs.o \ lapacke_dgetrs_work.o \ +lapacke_dgetsls.o \ +lapacke_dgetsls_work.o \ lapacke_dggbak.o \ lapacke_dggbak_work.o \ lapacke_dggbal.o \ @@ -1235,6 +1239,8 @@ lapacke_sgetri.o \ lapacke_sgetri_work.o \ lapacke_sgetrs.o \ lapacke_sgetrs_work.o \ +lapacke_sgetsls.o \ +lapacke_sgetsls_work.o \ lapacke_sggbak.o \ lapacke_sggbak_work.o \ lapacke_sggbal.o \ @@ -1759,6 +1765,8 @@ lapacke_zgetri.o \ lapacke_zgetri_work.o \ lapacke_zgetrs.o \ lapacke_zgetrs_work.o \ +lapacke_zgetsls.o \ +lapacke_zgetsls_work.o \ lapacke_zggbak.o \ lapacke_zggbak_work.o \ lapacke_zggbal.o \ diff --git a/LAPACKE/src/lapacke_cgetsls.c b/LAPACKE/src/lapacke_cgetsls.c new file mode 100644 index 00000000..8b35c105 --- /dev/null +++ b/LAPACKE/src/lapacke_cgetsls.c @@ -0,0 +1,82 @@ +/***************************************************************************** + 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 cgetsls +* Author: Intel Corporation +* Generated December 2016 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_cgetsls( int matrix_layout, char trans, lapack_int m, + lapack_int n, lapack_int nrhs, + lapack_complex_float* a, lapack_int lda, + lapack_complex_float* b, lapack_int ldb ) +{ + lapack_int info = 0; + 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_cgetsls", -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 -6; + } + if( LAPACKE_cge_nancheck( matrix_layout, MAX(m,n), nrhs, b, ldb ) ) { + return -8; + } +#endif + /* Query optimal working array(s) size */ + info = LAPACKE_cgetsls_work( matrix_layout, trans, m, n, nrhs, a, lda, b, ldb, + &work_query, lwork ); + if( info != 0 ) { + goto exit_level_0; + } + lwork = LAPACK_C2INT( work_query ); + /* Allocate memory for work arrays */ + work = (lapack_complex_float*) + LAPACKE_malloc( sizeof(lapack_complex_float) * lwork ); + if( work == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_0; + } + /* Call middle-level interface */ + info = LAPACKE_cgetsls_work( matrix_layout, trans, m, n, nrhs, a, lda, b, ldb, + work, lwork ); + /* Release memory and exit */ + LAPACKE_free( work ); +exit_level_0: + if( info == LAPACK_WORK_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_cgetsls", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_cgetsls_work.c b/LAPACKE/src/lapacke_cgetsls_work.c new file mode 100644 index 00000000..8f2ed4d0 --- /dev/null +++ b/LAPACKE/src/lapacke_cgetsls_work.c @@ -0,0 +1,112 @@ +/***************************************************************************** + 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 cgetsls +* Author: Intel Corporation +* Generated December 2016 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_cgetsls_work( int matrix_layout, char trans, lapack_int m, + lapack_int n, lapack_int nrhs, + lapack_complex_float* a, lapack_int lda, + lapack_complex_float* b, lapack_int ldb, + lapack_complex_float* work, lapack_int lwork ) +{ + lapack_int info = 0; + if( matrix_layout == LAPACK_COL_MAJOR ) { + /* Call LAPACK function and adjust info */ + LAPACK_cgetsls( &trans, &m, &n, &nrhs, a, &lda, b, &ldb, 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,MAX(m,n)); + lapack_complex_float* a_t = NULL; + lapack_complex_float* b_t = NULL; + /* Check leading dimension(s) */ + if( lda < n ) { + info = -7; + LAPACKE_xerbla( "LAPACKE_cgetsls_work", info ); + return info; + } + if( ldb < nrhs ) { + info = -9; + LAPACKE_xerbla( "LAPACKE_cgetsls_work", info ); + return info; + } + /* Query optimal working array(s) size if requested */ + if( lwork == -1 ) { + LAPACK_cgetsls( &trans, &m, &n, &nrhs, a, &lda_t, b, &ldb_t, 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,nrhs) ); + if( b_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_1; + } + /* Transpose input matrices */ + LAPACKE_cge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + LAPACKE_cge_trans( matrix_layout, MAX(m,n), nrhs, b, ldb, b_t, ldb_t ); + /* Call LAPACK function and adjust info */ + LAPACK_cgetsls( &trans, &m, &n, &nrhs, a_t, &lda_t, b_t, &ldb_t, 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, MAX(m,n), nrhs, b_t, ldb_t, b, + ldb ); + /* Release memory and exit */ + LAPACKE_free( b_t ); +exit_level_1: + LAPACKE_free( a_t ); +exit_level_0: + if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_cgetsls_work", info ); + } + } else { + info = -1; + LAPACKE_xerbla( "LAPACKE_cgetsls_work", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_dgetsls.c b/LAPACKE/src/lapacke_dgetsls.c new file mode 100644 index 00000000..57563f5e --- /dev/null +++ b/LAPACKE/src/lapacke_dgetsls.c @@ -0,0 +1,80 @@ +/***************************************************************************** + 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 dgetsls +* Author: Intel Corporation +* Generated December 2016 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_dgetsls( int matrix_layout, char trans, lapack_int m, + lapack_int n, lapack_int nrhs, double* a, + lapack_int lda, double* b, lapack_int ldb ) +{ + lapack_int info = 0; + lapack_int lwork = -1; + double* work = NULL; + double work_query; + if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { + LAPACKE_xerbla( "LAPACKE_dgetsls", -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 -6; + } + if( LAPACKE_dge_nancheck( matrix_layout, MAX(m,n), nrhs, b, ldb ) ) { + return -8; + } +#endif + /* Query optimal working array(s) size */ + info = LAPACKE_dgetsls_work( matrix_layout, trans, m, n, nrhs, a, lda, b, ldb, + &work_query, lwork ); + if( info != 0 ) { + goto exit_level_0; + } + lwork = (lapack_int)work_query; + /* Allocate memory for work arrays */ + 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_dgetsls_work( matrix_layout, trans, m, n, nrhs, a, lda, b, ldb, + work, lwork ); + /* Release memory and exit */ + LAPACKE_free( work ); +exit_level_0: + if( info == LAPACK_WORK_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_dgetsls", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_dgetsls_work.c b/LAPACKE/src/lapacke_dgetsls_work.c new file mode 100644 index 00000000..6f84d674 --- /dev/null +++ b/LAPACKE/src/lapacke_dgetsls_work.c @@ -0,0 +1,108 @@ +/***************************************************************************** + 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 dgetsls +* Author: Intel Corporation +* Generated December 2016 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_dgetsls_work( int matrix_layout, char trans, lapack_int m, + lapack_int n, lapack_int nrhs, double* a, + lapack_int lda, double* b, lapack_int ldb, + double* work, lapack_int lwork ) +{ + lapack_int info = 0; + if( matrix_layout == LAPACK_COL_MAJOR ) { + /* Call LAPACK function and adjust info */ + LAPACK_dgetsls( &trans, &m, &n, &nrhs, a, &lda, b, &ldb, 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,MAX(m,n)); + double* a_t = NULL; + double* b_t = NULL; + /* Check leading dimension(s) */ + if( lda < n ) { + info = -7; + LAPACKE_xerbla( "LAPACKE_dgetsls_work", info ); + return info; + } + if( ldb < nrhs ) { + info = -9; + LAPACKE_xerbla( "LAPACKE_dgetsls_work", info ); + return info; + } + /* Query optimal working array(s) size if requested */ + if( lwork == -1 ) { + LAPACK_dgetsls( &trans, &m, &n, &nrhs, a, &lda_t, b, &ldb_t, 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,nrhs) ); + if( b_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_1; + } + /* Transpose input matrices */ + LAPACKE_dge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + LAPACKE_dge_trans( matrix_layout, MAX(m,n), nrhs, b, ldb, b_t, ldb_t ); + /* Call LAPACK function and adjust info */ + LAPACK_dgetsls( &trans, &m, &n, &nrhs, a_t, &lda_t, b_t, &ldb_t, 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, MAX(m,n), nrhs, b_t, ldb_t, b, + ldb ); + /* Release memory and exit */ + LAPACKE_free( b_t ); +exit_level_1: + LAPACKE_free( a_t ); +exit_level_0: + if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_dgetsls_work", info ); + } + } else { + info = -1; + LAPACKE_xerbla( "LAPACKE_dgetsls_work", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_sgetsls.c b/LAPACKE/src/lapacke_sgetsls.c new file mode 100644 index 00000000..1a1d8f3a --- /dev/null +++ b/LAPACKE/src/lapacke_sgetsls.c @@ -0,0 +1,80 @@ +/***************************************************************************** + 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 sgetsls +* Author: Intel Corporation +* Generated December 2016 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_sgetsls( int matrix_layout, char trans, lapack_int m, + lapack_int n, lapack_int nrhs, float* a, + lapack_int lda, float* b, lapack_int ldb ) +{ + lapack_int info = 0; + lapack_int lwork = -1; + float* work = NULL; + float work_query; + if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { + LAPACKE_xerbla( "LAPACKE_sgetsls", -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 -6; + } + if( LAPACKE_sge_nancheck( matrix_layout, MAX(m,n), nrhs, b, ldb ) ) { + return -8; + } +#endif + /* Query optimal working array(s) size */ + info = LAPACKE_sgetsls_work( matrix_layout, trans, m, n, nrhs, a, lda, b, ldb, + &work_query, lwork ); + if( info != 0 ) { + goto exit_level_0; + } + lwork = (lapack_int)work_query; + /* Allocate memory for work arrays */ + 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_sgetsls_work( matrix_layout, trans, m, n, nrhs, a, lda, b, ldb, + work, lwork ); + /* Release memory and exit */ + LAPACKE_free( work ); +exit_level_0: + if( info == LAPACK_WORK_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_sgetsls", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_sgetsls_work.c b/LAPACKE/src/lapacke_sgetsls_work.c new file mode 100644 index 00000000..6f36379c --- /dev/null +++ b/LAPACKE/src/lapacke_sgetsls_work.c @@ -0,0 +1,108 @@ +/***************************************************************************** + 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 sgetsls +* Author: Intel Corporation +* Generated December 2016 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_sgetsls_work( int matrix_layout, char trans, lapack_int m, + lapack_int n, lapack_int nrhs, float* a, + lapack_int lda, float* b, lapack_int ldb, + float* work, lapack_int lwork ) +{ + lapack_int info = 0; + if( matrix_layout == LAPACK_COL_MAJOR ) { + /* Call LAPACK function and adjust info */ + LAPACK_sgetsls( &trans, &m, &n, &nrhs, a, &lda, b, &ldb, 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,MAX(m,n)); + float* a_t = NULL; + float* b_t = NULL; + /* Check leading dimension(s) */ + if( lda < n ) { + info = -7; + LAPACKE_xerbla( "LAPACKE_sgetsls_work", info ); + return info; + } + if( ldb < nrhs ) { + info = -9; + LAPACKE_xerbla( "LAPACKE_sgetsls_work", info ); + return info; + } + /* Query optimal working array(s) size if requested */ + if( lwork == -1 ) { + LAPACK_sgetsls( &trans, &m, &n, &nrhs, a, &lda_t, b, &ldb_t, 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,nrhs) ); + if( b_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_1; + } + /* Transpose input matrices */ + LAPACKE_sge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + LAPACKE_sge_trans( matrix_layout, MAX(m,n), nrhs, b, ldb, b_t, ldb_t ); + /* Call LAPACK function and adjust info */ + LAPACK_sgetsls( &trans, &m, &n, &nrhs, a_t, &lda_t, b_t, &ldb_t, 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, MAX(m,n), nrhs, b_t, ldb_t, b, + ldb ); + /* Release memory and exit */ + LAPACKE_free( b_t ); +exit_level_1: + LAPACKE_free( a_t ); +exit_level_0: + if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_sgetsls_work", info ); + } + } else { + info = -1; + LAPACKE_xerbla( "LAPACKE_sgetsls_work", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_zgetsls.c b/LAPACKE/src/lapacke_zgetsls.c new file mode 100644 index 00000000..6e73657d --- /dev/null +++ b/LAPACKE/src/lapacke_zgetsls.c @@ -0,0 +1,82 @@ +/***************************************************************************** + 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 zgetsls +* Author: Intel Corporation +* Generated December 2016 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_zgetsls( int matrix_layout, char trans, lapack_int m, + lapack_int n, lapack_int nrhs, + lapack_complex_double* a, lapack_int lda, + lapack_complex_double* b, lapack_int ldb ) +{ + lapack_int info = 0; + 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_zgetsls", -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 -6; + } + if( LAPACKE_zge_nancheck( matrix_layout, MAX(m,n), nrhs, b, ldb ) ) { + return -8; + } +#endif + /* Query optimal working array(s) size */ + info = LAPACKE_zgetsls_work( matrix_layout, trans, m, n, nrhs, a, lda, b, ldb, + &work_query, lwork ); + if( info != 0 ) { + goto exit_level_0; + } + lwork = LAPACK_Z2INT( work_query ); + /* Allocate memory for work arrays */ + work = (lapack_complex_double*) + LAPACKE_malloc( sizeof(lapack_complex_double) * lwork ); + if( work == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_0; + } + /* Call middle-level interface */ + info = LAPACKE_zgetsls_work( matrix_layout, trans, m, n, nrhs, a, lda, b, ldb, + work, lwork ); + /* Release memory and exit */ + LAPACKE_free( work ); +exit_level_0: + if( info == LAPACK_WORK_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_zgetsls", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_zgetsls_work.c b/LAPACKE/src/lapacke_zgetsls_work.c new file mode 100644 index 00000000..dca7d49a --- /dev/null +++ b/LAPACKE/src/lapacke_zgetsls_work.c @@ -0,0 +1,112 @@ +/***************************************************************************** + 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 zgetsls +* Author: Intel Corporation +* Generated December 2016 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_zgetsls_work( int matrix_layout, char trans, lapack_int m, + lapack_int n, lapack_int nrhs, + lapack_complex_double* a, lapack_int lda, + lapack_complex_double* b, lapack_int ldb, + lapack_complex_double* work, lapack_int lwork ) +{ + lapack_int info = 0; + if( matrix_layout == LAPACK_COL_MAJOR ) { + /* Call LAPACK function and adjust info */ + LAPACK_zgetsls( &trans, &m, &n, &nrhs, a, &lda, b, &ldb, 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,MAX(m,n)); + lapack_complex_double* a_t = NULL; + lapack_complex_double* b_t = NULL; + /* Check leading dimension(s) */ + if( lda < n ) { + info = -7; + LAPACKE_xerbla( "LAPACKE_zgetsls_work", info ); + return info; + } + if( ldb < nrhs ) { + info = -9; + LAPACKE_xerbla( "LAPACKE_zgetsls_work", info ); + return info; + } + /* Query optimal working array(s) size if requested */ + if( lwork == -1 ) { + LAPACK_zgetsls( &trans, &m, &n, &nrhs, a, &lda_t, b, &ldb_t, 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,nrhs) ); + if( b_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_1; + } + /* Transpose input matrices */ + LAPACKE_zge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + LAPACKE_zge_trans( matrix_layout, MAX(m,n), nrhs, b, ldb, b_t, ldb_t ); + /* Call LAPACK function and adjust info */ + LAPACK_zgetsls( &trans, &m, &n, &nrhs, a_t, &lda_t, b_t, &ldb_t, 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, MAX(m,n), nrhs, b_t, ldb_t, b, + ldb ); + /* Release memory and exit */ + LAPACKE_free( b_t ); +exit_level_1: + LAPACKE_free( a_t ); +exit_level_0: + if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_zgetsls_work", info ); + } + } else { + info = -1; + LAPACKE_xerbla( "LAPACKE_zgetsls_work", info ); + } + return info; +} |