diff --git a/.gitignore b/.gitignore index 852d05fcb..568e67b33 100644 --- a/.gitignore +++ b/.gitignore @@ -25,6 +25,7 @@ CBLAS/examples/cblas_ex2 # LAPACK testing TESTING/LIN/xlintst* TESTING/EIG/xeigtst* +TESTING/EIG/xdmd* TESTING/*.out TESTING/*.txt !TESTING/CMakeLists.txt diff --git a/LAPACKE/include/lapack.h b/LAPACKE/include/lapack.h index b5a276f5a..dffa6990f 100644 --- a/LAPACKE/include/lapack.h +++ b/LAPACKE/include/lapack.h @@ -3319,6 +3319,66 @@ void LAPACK_zgesdd_base( #define LAPACK_zgesdd(...) LAPACK_zgesdd_base(__VA_ARGS__) #endif +#define LAPACK_cgedmd LAPACK_GLOBAL(cgedmd,CGEDMD) +void LAPACK_cgedmd( + char const* jobs, char const* jobz, char const* jobf, + lapack_int const* whtsvd, lapack_int const* m, lapack_int const* n, + lapack_complex_float* x, lapack_int const* ldx, + lapack_complex_float* y, lapack_int const* ldy, lapack_int const* k, + lapack_complex_float* reig, lapack_complex_float* imeig, + lapack_complex_float* z, lapack_int const* ldz, lapack_complex_float* res, + lapack_complex_float* b, lapack_int const* ldb, + lapack_complex_float* w, lapack_int const* ldw, + lapack_complex_float* s, lapack_int const* lds, + lapack_complex_float* work, lapack_int const* lwork, + lapack_complex_float* iwork, lapack_int const* liwork, + lapack_int* info ); + +#define LAPACK_dgedmd LAPACK_GLOBAL(dgedmd,DGEDMD) +void LAPACK_dgedmd( + char const* jobs, char const* jobz, char const* jobf, + lapack_int const* whtsvd, lapack_int const* m, lapack_int const* n, + double* x, lapack_int const* ldx, + double* y, lapack_int const* ldy, lapack_int const* k, + double* reig, double* imeig, + double* z, lapack_int const* ldz, double* res, + double* b, lapack_int const* ldb, + double* w, lapack_int const* ldw, + double* s, lapack_int const* lds, + double* work, lapack_int const* lwork, + double* iwork, lapack_int const* liwork, + lapack_int* info ); + +#define LAPACK_sgedmd LAPACK_GLOBAL(sgedmd,SGEDMD) +void LAPACK_sgedmd( + char const* jobs, char const* jobz, char const* jobf, + lapack_int const* whtsvd, lapack_int const* m, lapack_int const* n, + float* x, lapack_int const* ldx, + float* y, lapack_int const* ldy, lapack_int const* k, + float* reig, float* imeig, + float* z, lapack_int const* ldz, float* res, + float* b, lapack_int const* ldb, + float* w, lapack_int const* ldw, + float* s, lapack_int const* lds, + float* work, lapack_int const* lwork, + float* iwork, lapack_int const* liwork, + lapack_int* info ); + +#define LAPACK_zgedmd LAPACK_GLOBAL(zgedmd,ZGEDMD) +void LAPACK_zgedmd( + char const* jobs, char const* jobz, char const* jobf, + lapack_int const* whtsvd, lapack_int const* m, lapack_int const* n, + lapack_complex_double* x, lapack_int const* ldx, + lapack_complex_double* y, lapack_int const* ldy, lapack_int const* k, + lapack_complex_double* reig, lapack_complex_double* imeig, + lapack_complex_double* z, lapack_int const* ldz, lapack_complex_double* res, + lapack_complex_double* b, lapack_int const* ldb, + lapack_complex_double* w, lapack_int const* ldw, + lapack_complex_double* s, lapack_int const* lds, + lapack_complex_double* work, lapack_int const* lwork, + lapack_complex_double* iwork, lapack_int const* liwork, + lapack_int* info ); + #define LAPACK_cgesv LAPACK_GLOBAL(cgesv,CGESV) void LAPACK_cgesv( lapack_int const* n, lapack_int const* nrhs, diff --git a/LAPACKE/include/lapacke.h b/LAPACKE/include/lapacke.h index 9998b1504..6cb41fd03 100644 --- a/LAPACKE/include/lapacke.h +++ b/LAPACKE/include/lapacke.h @@ -956,7 +956,7 @@ lapack_int LAPACKE_zgesvdq( int matrix_layout, char joba, char jobp, char jobr, lapack_int lda, double* s, lapack_complex_double* u, lapack_int ldu, lapack_complex_double* v, lapack_int ldv, lapack_int* numrank ); - + lapack_int LAPACKE_sgesvj( int matrix_layout, char joba, char jobu, char jobv, lapack_int m, lapack_int n, float* a, lapack_int lda, float* sva, lapack_int mv, float* v, lapack_int ldv, @@ -5712,6 +5712,58 @@ lapack_int LAPACKE_zgesdd_work( int matrix_layout, char jobz, lapack_int m, lapack_complex_double* work, lapack_int lwork, double* rwork, lapack_int* iwork ); +lapack_int LAPACKE_sgedmd_work( int matrix_layout, char jobs, char jobz, + char jobf, lapack_int whtsvd, lapack_int m, + lapack_int n, float* x, lapack_int ldx, + float* y, lapack_int ldy, lapack_int k, + float* reig, float* imeig, float* z, + lapack_int ldz, float* res, float* b, + lapack_int ldb, float* w, lapack_int ldw, + float* s, lapack_int lds, float* work, + lapack_int lwork, float* iwork, + lapack_int liwork ); + +lapack_int LAPACKE_dgedmd_work( int matrix_layout, char jobs, char jobz, + char jobf, lapack_int whtsvd, lapack_int m, + lapack_int n, double* x, lapack_int ldx, + double* y, lapack_int ldy, lapack_int k, + double* reig, double* imeig, double* z, + lapack_int ldz, double* res, double* b, + lapack_int ldb, double* w, lapack_int ldw, + double* s, lapack_int lds, double* work, + lapack_int lwork, double* iwork, + lapack_int liwork ); + +lapack_int LAPACKE_cgedmd_work( int matrix_layout, char jobs, char jobz, + char jobf, lapack_int whtsvd, lapack_int m, + lapack_int n, lapack_complex_float* x, + lapack_int ldx, lapack_complex_float* y, + lapack_int ldy, lapack_int k, + lapack_complex_float* reig, + lapack_complex_float* imeig, + lapack_complex_float* z, lapack_int ldz, + lapack_complex_float* res, + lapack_complex_float* b, lapack_int ldb, + lapack_complex_float* w, lapack_int ldw, + lapack_complex_float* s, lapack_int lds, + lapack_complex_float* work, lapack_int lwork, + lapack_complex_float* iwork, lapack_int liwork ); + +lapack_int LAPACKE_zgedmd_work( int matrix_layout, char jobs, char jobz, + char jobf, lapack_int whtsvd, lapack_int m, + lapack_int n, lapack_complex_double* x, + lapack_int ldx, lapack_complex_double* y, + lapack_int ldy, lapack_int k, + lapack_complex_double* reig, + lapack_complex_double* imeig, + lapack_complex_double* z, lapack_int ldz, + lapack_complex_double* res, + lapack_complex_double* b, lapack_int ldb, + lapack_complex_double* w, lapack_int ldw, + lapack_complex_double* s, lapack_int lds, + lapack_complex_double* work, lapack_int lwork, + lapack_complex_double* iwork, lapack_int liwork ); + lapack_int LAPACKE_sgesv_work( int matrix_layout, lapack_int n, lapack_int nrhs, float* a, lapack_int lda, lapack_int* ipiv, float* b, lapack_int ldb ); @@ -5833,7 +5885,7 @@ lapack_int LAPACKE_zgesvdq_work( int matrix_layout, char joba, char jobp, lapack_int* iwork, lapack_int liwork, lapack_complex_double* cwork, lapack_int lcwork, double* rwork, lapack_int lrwork); - + lapack_int LAPACKE_sgesvj_work( int matrix_layout, char joba, char jobu, char jobv, lapack_int m, lapack_int n, float* a, lapack_int lda, float* sva, lapack_int mv, @@ -12550,7 +12602,7 @@ lapack_int LAPACKE_zhegv_2stage_work( int matrix_layout, lapack_int itype, char //LAPACK 3.8.0 lapack_int LAPACKE_ssysv_aa_2stage( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, float* a, lapack_int lda, - float* tb, lapack_int ltb, lapack_int* ipiv, + float* tb, lapack_int ltb, lapack_int* ipiv, lapack_int* ipiv2, float* b, lapack_int ldb ); lapack_int LAPACKE_ssysv_aa_2stage_work( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, float* a, lapack_int lda, @@ -12560,7 +12612,7 @@ lapack_int LAPACKE_ssysv_aa_2stage_work( int matrix_layout, char uplo, lapack_in lapack_int LAPACKE_dsysv_aa_2stage( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, double* a, lapack_int lda, double* tb, lapack_int ltb, - lapack_int* ipiv, lapack_int* ipiv2, + lapack_int* ipiv, lapack_int* ipiv2, double* b, lapack_int ldb ); lapack_int LAPACKE_dsysv_aa_2stage_work( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, double* a, lapack_int lda, @@ -12612,10 +12664,10 @@ lapack_int LAPACKE_zhesv_aa_2stage_work( int matrix_layout, char uplo, lapack_in lapack_int ltb, lapack_int* ipiv, lapack_int* ipiv2, lapack_complex_double* b, lapack_int ldb, lapack_complex_double* work, lapack_int lwork ); - + lapack_int LAPACKE_ssytrf_aa_2stage( int matrix_layout, char uplo, lapack_int n, float* a, lapack_int lda, - float* tb, lapack_int ltb, lapack_int* ipiv, + float* tb, lapack_int ltb, lapack_int* ipiv, lapack_int* ipiv2 ); lapack_int LAPACKE_ssytrf_aa_2stage_work( int matrix_layout, char uplo, lapack_int n, float* a, lapack_int lda, @@ -12671,7 +12723,7 @@ lapack_int LAPACKE_zhetrf_aa_2stage_work( int matrix_layout, char uplo, lapack_i lapack_int LAPACKE_ssytrs_aa_2stage( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, float* a, lapack_int lda, - float* tb, lapack_int ltb, lapack_int* ipiv, + float* tb, lapack_int ltb, lapack_int* ipiv, lapack_int* ipiv2, float* b, lapack_int ldb ); lapack_int LAPACKE_ssytrs_aa_2stage_work( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, float* a, lapack_int lda, @@ -12680,7 +12732,7 @@ lapack_int LAPACKE_ssytrs_aa_2stage_work( int matrix_layout, char uplo, lapack_i lapack_int LAPACKE_dsytrs_aa_2stage( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, double* a, lapack_int lda, double* tb, lapack_int ltb, - lapack_int* ipiv, lapack_int* ipiv2, + lapack_int* ipiv, lapack_int* ipiv2, double* b, lapack_int ldb ); lapack_int LAPACKE_dsytrs_aa_2stage_work( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, double* a, lapack_int lda, @@ -12727,7 +12779,7 @@ lapack_int LAPACKE_zhetrs_aa_2stage_work( int matrix_layout, char uplo, lapack_i lapack_int lda, lapack_complex_double* tb, lapack_int ltb, lapack_int* ipiv, lapack_int* ipiv2, lapack_complex_double* b, lapack_int ldb ); - + /* APIs for set/get nancheck flags */ void LAPACKE_set_nancheck( int flag ); int LAPACKE_get_nancheck( void ); diff --git a/LAPACKE/src/CMakeLists.txt b/LAPACKE/src/CMakeLists.txt index 6ae06e42b..f2efd7fbb 100644 --- a/LAPACKE/src/CMakeLists.txt +++ b/LAPACKE/src/CMakeLists.txt @@ -89,6 +89,8 @@ lapacke_cgerqf.c lapacke_cgerqf_work.c lapacke_cgesdd.c lapacke_cgesdd_work.c +lapacke_cgedmd.c +lapacke_cgedmd_work.c lapacke_cgesv.c lapacke_cgesv_work.c lapacke_cgesvd.c @@ -711,6 +713,8 @@ lapacke_dgerqf.c lapacke_dgerqf_work.c lapacke_dgesdd.c lapacke_dgesdd_work.c +lapacke_dgedmd.c +lapacke_dgedmd_work.c lapacke_dgesv.c lapacke_dgesv_work.c lapacke_dgesvd.c @@ -1290,6 +1294,8 @@ lapacke_sgerqf.c lapacke_sgerqf_work.c lapacke_sgesdd.c lapacke_sgesdd_work.c +lapacke_sgedmd.c +lapacke_sgedmd_work.c lapacke_sgesv.c lapacke_sgesv_work.c lapacke_sgesvd.c @@ -1858,6 +1864,8 @@ lapacke_zgerqf.c lapacke_zgerqf_work.c lapacke_zgesdd.c lapacke_zgesdd_work.c +lapacke_zgedmd.c +lapacke_zgedmd_work.c lapacke_zgesv.c lapacke_zgesv_work.c lapacke_zgesvd.c diff --git a/LAPACKE/src/Makefile b/LAPACKE/src/Makefile index 65e0e557f..6483014ae 100644 --- a/LAPACKE/src/Makefile +++ b/LAPACKE/src/Makefile @@ -136,6 +136,8 @@ lapacke_cgerqf.o \ lapacke_cgerqf_work.o \ lapacke_cgesdd.o \ lapacke_cgesdd_work.o \ +lapacke_cgedmd.o \ +lapacke_cgedmd_work.o \ lapacke_cgesv.o \ lapacke_cgesv_work.o \ lapacke_cgesvd.o \ @@ -758,6 +760,8 @@ lapacke_dgerqf.o \ lapacke_dgerqf_work.o \ lapacke_dgesdd.o \ lapacke_dgesdd_work.o \ +lapacke_dgedmd.o \ +lapacke_dgedmd_work.o \ lapacke_dgesv.o \ lapacke_dgesv_work.o \ lapacke_dgesvd.o \ @@ -1332,6 +1336,8 @@ lapacke_sgerqf.o \ lapacke_sgerqf_work.o \ lapacke_sgesdd.o \ lapacke_sgesdd_work.o \ +lapacke_sgedmd.o \ +lapacke_sgedmd_work.o \ lapacke_sgesv.o \ lapacke_sgesv_work.o \ lapacke_sgesvd.o \ @@ -1900,6 +1906,8 @@ lapacke_zgerqf.o \ lapacke_zgerqf_work.o \ lapacke_zgesdd.o \ lapacke_zgesdd_work.o \ +lapacke_zgedmd.o \ +lapacke_zgedmd_work.o \ lapacke_zgesv.o \ lapacke_zgesv_work.o \ lapacke_zgesvd.o \ diff --git a/LAPACKE/src/lapacke_cgedmd.c b/LAPACKE/src/lapacke_cgedmd.c new file mode 100644 index 000000000..2491fbe2d --- /dev/null +++ b/LAPACKE/src/lapacke_cgedmd.c @@ -0,0 +1,114 @@ +/***************************************************************************** + 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 cgedmd +* Author: Intel Corporation +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_cgedmd( int matrix_layout, char jobs, char jobz, char jobf, + lapack_int whtsvd, lapack_int m, lapack_int n, + lapack_complex_float* x, lapack_int ldx, + lapack_complex_float* y, lapack_int ldy, lapack_int k, + lapack_complex_float* reig, lapack_complex_float* imeig, + lapack_complex_float* z, lapack_int ldz, + lapack_complex_float* res, lapack_complex_float* b, + lapack_int ldb, lapack_complex_float* w, + lapack_int ldw, lapack_complex_float* s, lapack_int lds) +{ + lapack_int info = 0; + lapack_int lwork = -1; + lapack_int liwork = -1; + lapack_complex_float* work = NULL; + lapack_complex_float* iwork = NULL; + lapack_complex_float work_query; + lapack_complex_float iwork_query; + if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { + LAPACKE_xerbla( "LAPACKE_cgedmd", -1 ); + return -1; + } +#ifndef LAPACK_DISABLE_NAN_CHECK + if( LAPACKE_get_nancheck() ) { + /* Optionally check input matrices for NaNs */ + if( LAPACKE_cge_nancheck( matrix_layout, m, n, x, ldx ) ) { + return -4; + } + if( LAPACKE_cge_nancheck( matrix_layout, m, n, y, ldy ) ) { + return -4; + } + if( LAPACKE_cge_nancheck( matrix_layout, m, n, z, ldz ) ) { + return -4; + } + if( LAPACKE_cge_nancheck( matrix_layout, m, n, b, ldb ) ) { + return -4; + } + if( LAPACKE_cge_nancheck( matrix_layout, m, n, s, lds ) ) { + return -4; + } + if( LAPACKE_cge_nancheck( matrix_layout, m, n, w, ldw ) ) { + return -4; + } + } +#endif + /* Query optimal working array(s) size */ + info = LAPACKE_cgedmd_work( matrix_layout, jobs, jobz, jobf, whtsvd, m, n, + x, ldx, y, ldy, k, reig, imeig, z, ldz, res, + b, ldb, w, ldw, s, lds, &work_query, lwork, + &iwork_query, liwork ); + + if( info != 0 ) { + goto exit_level_0; + } + lwork = (lapack_int) work_query; + liwork = (lapack_int) iwork_query; + /* Allocate memory for work arrays */ + work = (lapack_complex_float*)LAPACKE_malloc( sizeof(lapack_complex_float) * lwork ); + iwork = (lapack_complex_float*)LAPACKE_malloc( sizeof(lapack_complex_float) * liwork ); + if( work == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_0; + } + if( iwork == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_0; + } + /* Call middle-level interface */ + info = LAPACKE_cgedmd_work( matrix_layout, jobs, jobz, jobf, whtsvd, m, n, + x, ldx, y, ldy, k, reig, imeig, z, ldz, res, + b, ldb, w, ldw, s, lds, work, lwork, iwork, + liwork ); + /* Release memory and exit */ + LAPACKE_free( work ); + LAPACKE_free( iwork ); +exit_level_0: + if( info == LAPACK_WORK_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_cgedmd", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_cgedmd_work.c b/LAPACKE/src/lapacke_cgedmd_work.c new file mode 100644 index 000000000..4069aca44 --- /dev/null +++ b/LAPACKE/src/lapacke_cgedmd_work.c @@ -0,0 +1,175 @@ +/***************************************************************************** + 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 cgedmd +* Author: Intel Corporation +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_cgedmd_work( int matrix_layout, char jobs, char jobz, + char jobf, lapack_int whtsvd, lapack_int m, + lapack_int n, lapack_complex_float* x, lapack_int ldx, + lapack_complex_float* y, lapack_int ldy, lapack_int k, + lapack_complex_float* reig, lapack_complex_float* imeig, + lapack_complex_float* z, lapack_int ldz, + lapack_complex_float* res, lapack_complex_float* b, + lapack_int ldb, lapack_complex_float* w, + lapack_int ldw, lapack_complex_float* s, lapack_int lds, + lapack_complex_float* work, lapack_int lwork, + lapack_complex_float* iwork, lapack_int liwork ) +{ + lapack_int info = 0; + if( matrix_layout == LAPACK_COL_MAJOR ) { + /* Call LAPACK function and adjust info */ + LAPACK_cgedmd( &jobs, &jobz, &jobf, &whtsvd, &m, &n, x, &ldx, y, &ldy, + &k, reig, imeig, z, &ldz, res, b, &ldb, w, &ldw, s, &lds, + work, &lwork, iwork, &liwork, &info ); + if( info < 0 ) { + info = info - 1; + } + } else if( matrix_layout == LAPACK_ROW_MAJOR ) { + lapack_int ldx_t = MAX(1,m); + lapack_int ldy_t = MAX(1,m); + lapack_int ldz_t = MAX(1,m); + lapack_int ldb_t = MAX(1,m); + lapack_int ldw_t = MAX(1,m); + lapack_int lds_t = MAX(1,m); + lapack_complex_float* x_t = NULL; + lapack_complex_float* y_t = NULL; + lapack_complex_float* z_t = NULL; + lapack_complex_float* b_t = NULL; + lapack_complex_float* w_t = NULL; + lapack_complex_float* s_t = NULL; + /* Check leading dimension(s) */ + if( ldx < n ) { + info = -5; + LAPACKE_xerbla( "LAPACKE_cgedmd_work", info ); + return info; + } + if( ldy < n ) { + info = -5; + LAPACKE_xerbla( "LAPACKE_cgedmd_work", info ); + return info; + } + if( ldz < n ) { + info = -5; + LAPACKE_xerbla( "LAPACKE_cgedmd_work", info ); + return info; + } + if( ldb < n ) { + info = -5; + LAPACKE_xerbla( "LAPACKE_cgedmd_work", info ); + return info; + } + if( ldw < n ) { + info = -5; + LAPACKE_xerbla( "LAPACKE_cgedmd_work", info ); + return info; + } + if( lds < n ) { + info = -5; + LAPACKE_xerbla( "LAPACKE_cgedmd_work", info ); + return info; + } + /* Query optimal working array(s) size if requested */ + if( lwork == -1 ) { + LAPACK_cgedmd( &jobs, &jobz, &jobf, &whtsvd, &m, &n, x, &ldx, y, &ldy, + &k, reig, imeig, z, &ldz, res, b, &ldb, w, &ldw, s, &lds, + work, &lwork, iwork, &liwork, &info ); + return (info < 0) ? (info - 1) : info; + } + /* Allocate memory for temporary array(s) */ + x_t = (lapack_complex_float*)LAPACKE_malloc( sizeof(lapack_complex_float) * ldx_t * MAX(1,n) ); + y_t = (lapack_complex_float*)LAPACKE_malloc( sizeof(lapack_complex_float) * ldy_t * MAX(1,n) ); + z_t = (lapack_complex_float*)LAPACKE_malloc( sizeof(lapack_complex_float) * ldz_t * MAX(1,n) ); + b_t = (lapack_complex_float*)LAPACKE_malloc( sizeof(lapack_complex_float) * ldb_t * MAX(1,n) ); + w_t = (lapack_complex_float*)LAPACKE_malloc( sizeof(lapack_complex_float) * ldw_t * MAX(1,n) ); + s_t = (lapack_complex_float*)LAPACKE_malloc( sizeof(lapack_complex_float) * lds_t * MAX(1,n) ); + if( x_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_0; + } + if( y_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_0; + } + if( z_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_0; + } + if( b_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_0; + } + if( w_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_0; + } + if( s_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_0; + } + /* Transpose input matrices */ + LAPACKE_cge_trans( matrix_layout, m, n, x, ldx, x_t, ldx_t ); + LAPACKE_cge_trans( matrix_layout, m, n, y, ldy, y_t, ldy_t ); + LAPACKE_cge_trans( matrix_layout, m, n, z, ldz, z_t, ldz_t ); + LAPACKE_cge_trans( matrix_layout, m, n, b, ldb, b_t, ldb_t ); + LAPACKE_cge_trans( matrix_layout, m, n, w, ldw, w_t, ldw_t ); + LAPACKE_cge_trans( matrix_layout, m, n, s, lds, s_t, lds_t ); + /* Call LAPACK function and adjust info */ + LAPACK_cgedmd( &jobs, &jobz, &jobf, &whtsvd, &m, &n, x_t, &ldx_t, y_t, + &ldy_t, &k, reig, imeig, z_t, &ldz_t, res, b_t, &ldb_t, + w_t, &ldw_t, s_t, &lds_t, work, &lwork, iwork, &liwork, &info ); + if( info < 0 ) { + info = info - 1; + } + /* Transpose output matrices */ + LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, x_t, ldx_t, x, ldx ); + LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, y_t, ldy_t, y, ldy ); + LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, z_t, ldz_t, z, ldz ); + LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb ); + LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, w_t, ldw_t, w, ldw ); + LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, s_t, lds_t, s, lds ); + /* Release memory and exit */ + LAPACKE_free( x_t ); + LAPACKE_free( y_t ); + LAPACKE_free( z_t ); + LAPACKE_free( b_t ); + LAPACKE_free( w_t ); + LAPACKE_free( s_t ); +exit_level_0: + if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_cgedmd_work", info ); + } + } else { + info = -1; + LAPACKE_xerbla( "LAPACKE_cgedmd_work", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_dgedmd.c b/LAPACKE/src/lapacke_dgedmd.c new file mode 100644 index 000000000..6d3a521b3 --- /dev/null +++ b/LAPACKE/src/lapacke_dgedmd.c @@ -0,0 +1,111 @@ +/***************************************************************************** + 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 dgedmd +* Author: Intel Corporation +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_dgedmd( int matrix_layout, char jobs, char jobz, char jobf, + lapack_int whtsvd, lapack_int m, lapack_int n, + double* x, lapack_int ldx, double* y, lapack_int ldy, + lapack_int k, double* reig, double* imeig, double* z, + lapack_int ldz, double* res, double* b, lapack_int ldb, + double* w, lapack_int ldw, double* s, lapack_int lds) +{ + lapack_int info = 0; + lapack_int lwork = -1; + lapack_int liwork = -1; + double* work = NULL; + double* iwork = NULL; + double work_query; + double iwork_query; + if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { + LAPACKE_xerbla( "LAPACKE_dgedmd", -1 ); + return -1; + } +#ifndef LAPACK_DISABLE_NAN_CHECK + if( LAPACKE_get_nancheck() ) { + /* Optionally check input matrices for NaNs */ + if( LAPACKE_dge_nancheck( matrix_layout, m, n, x, ldx ) ) { + return -4; + } + if( LAPACKE_dge_nancheck( matrix_layout, m, n, y, ldy ) ) { + return -4; + } + if( LAPACKE_dge_nancheck( matrix_layout, m, n, z, ldz ) ) { + return -4; + } + if( LAPACKE_dge_nancheck( matrix_layout, m, n, b, ldb ) ) { + return -4; + } + if( LAPACKE_dge_nancheck( matrix_layout, m, n, s, lds ) ) { + return -4; + } + if( LAPACKE_dge_nancheck( matrix_layout, m, n, w, ldw ) ) { + return -4; + } + } +#endif + /* Query optimal working array(s) size */ + info = LAPACKE_dgedmd_work( matrix_layout, jobs, jobz, jobf, whtsvd, m, n, + x, ldx, y, ldy, k, reig, imeig, z, ldz, res, + b, ldb, w, ldw, s, lds, &work_query, lwork, + &iwork_query, liwork ); + + if( info != 0 ) { + goto exit_level_0; + } + lwork = (lapack_int) work_query; + liwork = (lapack_int) iwork_query; + /* Allocate memory for work arrays */ + work = (double*)LAPACKE_malloc( sizeof(double) * lwork ); + iwork = (double*)LAPACKE_malloc( sizeof(double) * liwork ); + if( work == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_0; + } + if( iwork == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_0; + } + /* Call middle-level interface */ + info = LAPACKE_dgedmd_work( matrix_layout, jobs, jobz, jobf, whtsvd, m, n, + x, ldx, y, ldy, k, reig, imeig, z, ldz, res, + b, ldb, w, ldw, s, lds, work, lwork, iwork, + liwork ); + /* Release memory and exit */ + LAPACKE_free( work ); + LAPACKE_free( iwork ); +exit_level_0: + if( info == LAPACK_WORK_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_dgedmd", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_dgedmd_work.c b/LAPACKE/src/lapacke_dgedmd_work.c new file mode 100644 index 000000000..6d7575f22 --- /dev/null +++ b/LAPACKE/src/lapacke_dgedmd_work.c @@ -0,0 +1,173 @@ +/***************************************************************************** + 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 dgedmd +* Author: Intel Corporation +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_dgedmd_work( int matrix_layout, char jobs, char jobz, + char jobf, lapack_int whtsvd, lapack_int m, + lapack_int n, double* x, lapack_int ldx, + double* y, lapack_int ldy, lapack_int k, + double* reig, double* imeig, double* z, + lapack_int ldz, double* res, double* b, + lapack_int ldb, double* w, lapack_int ldw, + double* s, lapack_int lds, double* work, + lapack_int lwork, double* iwork, lapack_int liwork ) +{ + lapack_int info = 0; + if( matrix_layout == LAPACK_COL_MAJOR ) { + /* Call LAPACK function and adjust info */ + LAPACK_dgedmd( &jobs, &jobz, &jobf, &whtsvd, &m, &n, x, &ldx, y, &ldy, + &k, reig, imeig, z, &ldz, res, b, &ldb, w, &ldw, s, &lds, + work, &lwork, iwork, &liwork, &info ); + if( info < 0 ) { + info = info - 1; + } + } else if( matrix_layout == LAPACK_ROW_MAJOR ) { + lapack_int ldx_t = MAX(1,m); + lapack_int ldy_t = MAX(1,m); + lapack_int ldz_t = MAX(1,m); + lapack_int ldb_t = MAX(1,m); + lapack_int ldw_t = MAX(1,m); + lapack_int lds_t = MAX(1,m); + double* x_t = NULL; + double* y_t = NULL; + double* z_t = NULL; + double* b_t = NULL; + double* w_t = NULL; + double* s_t = NULL; + /* Check leading dimension(s) */ + if( ldx < n ) { + info = -5; + LAPACKE_xerbla( "LAPACKE_dgedmd_work", info ); + return info; + } + if( ldy < n ) { + info = -5; + LAPACKE_xerbla( "LAPACKE_dgedmd_work", info ); + return info; + } + if( ldz < n ) { + info = -5; + LAPACKE_xerbla( "LAPACKE_dgedmd_work", info ); + return info; + } + if( ldb < n ) { + info = -5; + LAPACKE_xerbla( "LAPACKE_dgedmd_work", info ); + return info; + } + if( ldw < n ) { + info = -5; + LAPACKE_xerbla( "LAPACKE_dgedmd_work", info ); + return info; + } + if( lds < n ) { + info = -5; + LAPACKE_xerbla( "LAPACKE_dgedmd_work", info ); + return info; + } + /* Query optimal working array(s) size if requested */ + if( lwork == -1 ) { + LAPACK_dgedmd( &jobs, &jobz, &jobf, &whtsvd, &m, &n, x, &ldx, y, &ldy, + &k, reig, imeig, z, &ldz, res, b, &ldb, w, &ldw, s, &lds, + work, &lwork, iwork, &liwork, &info ); + return (info < 0) ? (info - 1) : info; + } + /* Allocate memory for temporary array(s) */ + x_t = (double*)LAPACKE_malloc( sizeof(double) * ldx_t * MAX(1,n) ); + y_t = (double*)LAPACKE_malloc( sizeof(double) * ldy_t * MAX(1,n) ); + z_t = (double*)LAPACKE_malloc( sizeof(double) * ldz_t * MAX(1,n) ); + b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,n) ); + w_t = (double*)LAPACKE_malloc( sizeof(double) * ldw_t * MAX(1,n) ); + s_t = (double*)LAPACKE_malloc( sizeof(double) * lds_t * MAX(1,n) ); + if( x_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_0; + } + if( y_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_0; + } + if( z_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_0; + } + if( b_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_0; + } + if( w_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_0; + } + if( s_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_0; + } + /* Transpose input matrices */ + LAPACKE_dge_trans( matrix_layout, m, n, x, ldx, x_t, ldx_t ); + LAPACKE_dge_trans( matrix_layout, m, n, y, ldy, y_t, ldy_t ); + LAPACKE_dge_trans( matrix_layout, m, n, z, ldz, z_t, ldz_t ); + LAPACKE_dge_trans( matrix_layout, m, n, b, ldb, b_t, ldb_t ); + LAPACKE_dge_trans( matrix_layout, m, n, w, ldw, w_t, ldw_t ); + LAPACKE_dge_trans( matrix_layout, m, n, s, lds, s_t, lds_t ); + /* Call LAPACK function and adjust info */ + LAPACK_dgedmd( &jobs, &jobz, &jobf, &whtsvd, &m, &n, x_t, &ldx_t, y_t, + &ldy_t, &k, reig, imeig, z_t, &ldz_t, res, b_t, &ldb_t, + w_t, &ldw_t, s_t, &lds_t, work, &lwork, iwork, &liwork, &info ); + if( info < 0 ) { + info = info - 1; + } + /* Transpose output matrices */ + LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, x_t, ldx_t, x, ldx ); + LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, y_t, ldy_t, y, ldy ); + LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, z_t, ldz_t, z, ldz ); + LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb ); + LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, w_t, ldw_t, w, ldw ); + LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, s_t, lds_t, s, lds ); + /* Release memory and exit */ + LAPACKE_free( x_t ); + LAPACKE_free( y_t ); + LAPACKE_free( z_t ); + LAPACKE_free( b_t ); + LAPACKE_free( w_t ); + LAPACKE_free( s_t ); +exit_level_0: + if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_dgedmd_work", info ); + } + } else { + info = -1; + LAPACKE_xerbla( "LAPACKE_dgedmd_work", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_sgedmd.c b/LAPACKE/src/lapacke_sgedmd.c new file mode 100644 index 000000000..d405ccabb --- /dev/null +++ b/LAPACKE/src/lapacke_sgedmd.c @@ -0,0 +1,111 @@ +/***************************************************************************** + 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 sgedmd +* Author: Intel Corporation +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_sgedmd( int matrix_layout, char jobs, char jobz, char jobf, + lapack_int whtsvd, lapack_int m, lapack_int n, + float* x, lapack_int ldx, float* y, lapack_int ldy, + lapack_int k, float* reig, float* imeig, float* z, + lapack_int ldz, float* res, float* b, lapack_int ldb, + float* w, lapack_int ldw, float* s, lapack_int lds) +{ + lapack_int info = 0; + lapack_int lwork = -1; + lapack_int liwork = -1; + float* work = NULL; + float* iwork = NULL; + float work_query; + float iwork_query; + if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { + LAPACKE_xerbla( "LAPACKE_sgedmd", -1 ); + return -1; + } +#ifndef LAPACK_DISABLE_NAN_CHECK + if( LAPACKE_get_nancheck() ) { + /* Optionally check input matrices for NaNs */ + if( LAPACKE_sge_nancheck( matrix_layout, m, n, x, ldx ) ) { + return -4; + } + if( LAPACKE_sge_nancheck( matrix_layout, m, n, y, ldy ) ) { + return -4; + } + if( LAPACKE_sge_nancheck( matrix_layout, m, n, z, ldz ) ) { + return -4; + } + if( LAPACKE_sge_nancheck( matrix_layout, m, n, b, ldb ) ) { + return -4; + } + if( LAPACKE_sge_nancheck( matrix_layout, m, n, s, lds ) ) { + return -4; + } + if( LAPACKE_sge_nancheck( matrix_layout, m, n, w, ldw ) ) { + return -4; + } + } +#endif + /* Query optimal working array(s) size */ + info = LAPACKE_sgedmd_work( matrix_layout, jobs, jobz, jobf, whtsvd, m, n, + x, ldx, y, ldy, k, reig, imeig, z, ldz, res, + b, ldb, w, ldw, s, lds, &work_query, lwork, + &iwork_query, liwork ); + + if( info != 0 ) { + goto exit_level_0; + } + lwork = (lapack_int) work_query; + liwork = (lapack_int) iwork_query; + /* Allocate memory for work arrays */ + work = (float*)LAPACKE_malloc( sizeof(float) * lwork ); + iwork = (float*)LAPACKE_malloc( sizeof(float) * liwork ); + if( work == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_0; + } + if( iwork == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_0; + } + /* Call middle-level interface */ + info = LAPACKE_sgedmd_work( matrix_layout, jobs, jobz, jobf, whtsvd, m, n, + x, ldx, y, ldy, k, reig, imeig, z, ldz, res, + b, ldb, w, ldw, s, lds, work, lwork, iwork, + liwork ); + /* Release memory and exit */ + LAPACKE_free( work ); + LAPACKE_free( iwork ); +exit_level_0: + if( info == LAPACK_WORK_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_sgedmd", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_sgedmd_work.c b/LAPACKE/src/lapacke_sgedmd_work.c new file mode 100644 index 000000000..cc3623b39 --- /dev/null +++ b/LAPACKE/src/lapacke_sgedmd_work.c @@ -0,0 +1,173 @@ +/***************************************************************************** + 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 sgedmd +* Author: Intel Corporation +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_sgedmd_work( int matrix_layout, char jobs, char jobz, + char jobf, lapack_int whtsvd, lapack_int m, + lapack_int n, float* x, lapack_int ldx, + float* y, lapack_int ldy, lapack_int k, + float* reig, float* imeig, float* z, + lapack_int ldz, float* res, float* b, + lapack_int ldb, float* w, lapack_int ldw, + float* s, lapack_int lds, float* work, + lapack_int lwork, float* iwork, lapack_int liwork ) +{ + lapack_int info = 0; + if( matrix_layout == LAPACK_COL_MAJOR ) { + /* Call LAPACK function and adjust info */ + LAPACK_sgedmd( &jobs, &jobz, &jobf, &whtsvd, &m, &n, x, &ldx, y, &ldy, + &k, reig, imeig, z, &ldz, res, b, &ldb, w, &ldw, s, &lds, + work, &lwork, iwork, &liwork, &info ); + if( info < 0 ) { + info = info - 1; + } + } else if( matrix_layout == LAPACK_ROW_MAJOR ) { + lapack_int ldx_t = MAX(1,m); + lapack_int ldy_t = MAX(1,m); + lapack_int ldz_t = MAX(1,m); + lapack_int ldb_t = MAX(1,m); + lapack_int ldw_t = MAX(1,m); + lapack_int lds_t = MAX(1,m); + float* x_t = NULL; + float* y_t = NULL; + float* z_t = NULL; + float* b_t = NULL; + float* w_t = NULL; + float* s_t = NULL; + /* Check leading dimension(s) */ + if( ldx < n ) { + info = -5; + LAPACKE_xerbla( "LAPACKE_sgedmd_work", info ); + return info; + } + if( ldy < n ) { + info = -5; + LAPACKE_xerbla( "LAPACKE_sgedmd_work", info ); + return info; + } + if( ldz < n ) { + info = -5; + LAPACKE_xerbla( "LAPACKE_sgedmd_work", info ); + return info; + } + if( ldb < n ) { + info = -5; + LAPACKE_xerbla( "LAPACKE_sgedmd_work", info ); + return info; + } + if( ldw < n ) { + info = -5; + LAPACKE_xerbla( "LAPACKE_sgedmd_work", info ); + return info; + } + if( lds < n ) { + info = -5; + LAPACKE_xerbla( "LAPACKE_sgedmd_work", info ); + return info; + } + /* Query optimal working array(s) size if requested */ + if( lwork == -1 ) { + LAPACK_sgedmd( &jobs, &jobz, &jobf, &whtsvd, &m, &n, x, &ldx, y, &ldy, + &k, reig, imeig, z, &ldz, res, b, &ldb, w, &ldw, s, &lds, + work, &lwork, iwork, &liwork, &info ); + return (info < 0) ? (info - 1) : info; + } + /* Allocate memory for temporary array(s) */ + x_t = (float*)LAPACKE_malloc( sizeof(float) * ldx_t * MAX(1,n) ); + y_t = (float*)LAPACKE_malloc( sizeof(float) * ldy_t * MAX(1,n) ); + z_t = (float*)LAPACKE_malloc( sizeof(float) * ldz_t * MAX(1,n) ); + b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,n) ); + w_t = (float*)LAPACKE_malloc( sizeof(float) * ldw_t * MAX(1,n) ); + s_t = (float*)LAPACKE_malloc( sizeof(float) * lds_t * MAX(1,n) ); + if( x_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_0; + } + if( y_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_0; + } + if( z_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_0; + } + if( b_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_0; + } + if( w_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_0; + } + if( s_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_0; + } + /* Transpose input matrices */ + LAPACKE_sge_trans( matrix_layout, m, n, x, ldx, x_t, ldx_t ); + LAPACKE_sge_trans( matrix_layout, m, n, y, ldy, y_t, ldy_t ); + LAPACKE_sge_trans( matrix_layout, m, n, z, ldz, z_t, ldz_t ); + LAPACKE_sge_trans( matrix_layout, m, n, b, ldb, b_t, ldb_t ); + LAPACKE_sge_trans( matrix_layout, m, n, w, ldw, w_t, ldw_t ); + LAPACKE_sge_trans( matrix_layout, m, n, s, lds, s_t, lds_t ); + /* Call LAPACK function and adjust info */ + LAPACK_sgedmd( &jobs, &jobz, &jobf, &whtsvd, &m, &n, x_t, &ldx_t, y_t, + &ldy_t, &k, reig, imeig, z_t, &ldz_t, res, b_t, &ldb_t, + w_t, &ldw_t, s_t, &lds_t, work, &lwork, iwork, &liwork, &info ); + if( info < 0 ) { + info = info - 1; + } + /* Transpose output matrices */ + LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, x_t, ldx_t, x, ldx ); + LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, y_t, ldy_t, y, ldy ); + LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, z_t, ldz_t, z, ldz ); + LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb ); + LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, w_t, ldw_t, w, ldw ); + LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, s_t, lds_t, s, lds ); + /* Release memory and exit */ + LAPACKE_free( x_t ); + LAPACKE_free( y_t ); + LAPACKE_free( z_t ); + LAPACKE_free( b_t ); + LAPACKE_free( w_t ); + LAPACKE_free( s_t ); +exit_level_0: + if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_sgedmd_work", info ); + } + } else { + info = -1; + LAPACKE_xerbla( "LAPACKE_sgedmd_work", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_zgedmd.c b/LAPACKE/src/lapacke_zgedmd.c new file mode 100644 index 000000000..cbf3cacf2 --- /dev/null +++ b/LAPACKE/src/lapacke_zgedmd.c @@ -0,0 +1,115 @@ +/***************************************************************************** + 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 zgedmd +* Author: Intel Corporation +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_zgedmd( int matrix_layout, char jobs, char jobz, char jobf, + lapack_int whtsvd, lapack_int m, lapack_int n, + lapack_complex_double* x, lapack_int ldx, + lapack_complex_double* y, lapack_int ldy, + lapack_int k, lapack_complex_double* reig, + lapack_complex_double* imeig, lapack_complex_double* z, + lapack_int ldz, lapack_complex_double* res, + lapack_complex_double* b, lapack_int ldb, + lapack_complex_double* w, lapack_int ldw, + lapack_complex_double* s, lapack_int lds) +{ + lapack_int info = 0; + lapack_int lwork = -1; + lapack_int liwork = -1; + lapack_complex_double* work = NULL; + lapack_complex_double* iwork = NULL; + lapack_complex_double work_query; + lapack_complex_double iwork_query; + if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { + LAPACKE_xerbla( "LAPACKE_zgedmd", -1 ); + return -1; + } +#ifndef LAPACK_DISABLE_NAN_CHECK + if( LAPACKE_get_nancheck() ) { + /* Optionally check input matrices for NaNs */ + if( LAPACKE_zge_nancheck( matrix_layout, m, n, x, ldx ) ) { + return -4; + } + if( LAPACKE_zge_nancheck( matrix_layout, m, n, y, ldy ) ) { + return -4; + } + if( LAPACKE_zge_nancheck( matrix_layout, m, n, z, ldz ) ) { + return -4; + } + if( LAPACKE_zge_nancheck( matrix_layout, m, n, b, ldb ) ) { + return -4; + } + if( LAPACKE_zge_nancheck( matrix_layout, m, n, s, lds ) ) { + return -4; + } + if( LAPACKE_zge_nancheck( matrix_layout, m, n, w, ldw ) ) { + return -4; + } + } +#endif + /* Query optimal working array(s) size */ + info = LAPACKE_zgedmd_work( matrix_layout, jobs, jobz, jobf, whtsvd, m, n, + x, ldx, y, ldy, k, reig, imeig, z, ldz, res, + b, ldb, w, ldw, s, lds, &work_query, lwork, + &iwork_query, liwork ); + + if( info != 0 ) { + goto exit_level_0; + } + lwork = (lapack_int) work_query; + liwork = (lapack_int) iwork_query; + /* Allocate memory for work arrays */ + work = (lapack_complex_double*)LAPACKE_malloc( sizeof(lapack_complex_double) * lwork ); + iwork = (lapack_complex_double*)LAPACKE_malloc( sizeof(lapack_complex_double) * liwork ); + if( work == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_0; + } + if( iwork == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_0; + } + /* Call middle-level interface */ + info = LAPACKE_zgedmd_work( matrix_layout, jobs, jobz, jobf, whtsvd, m, n, + x, ldx, y, ldy, k, reig, imeig, z, ldz, res, + b, ldb, w, ldw, s, lds, work, lwork, iwork, + liwork ); + /* Release memory and exit */ + LAPACKE_free( work ); + LAPACKE_free( iwork ); +exit_level_0: + if( info == LAPACK_WORK_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_zgedmd", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_zgedmd_work.c b/LAPACKE/src/lapacke_zgedmd_work.c new file mode 100644 index 000000000..a4ad0a6fc --- /dev/null +++ b/LAPACKE/src/lapacke_zgedmd_work.c @@ -0,0 +1,177 @@ +/***************************************************************************** + 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 zgedmd +* Author: Intel Corporation +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_zgedmd_work( int matrix_layout, char jobs, char jobz, + char jobf, lapack_int whtsvd, lapack_int m, + lapack_int n, lapack_complex_double* x, + lapack_int ldx, lapack_complex_double* y, + lapack_int ldy, lapack_int k, + lapack_complex_double* reig, + lapack_complex_double* imeig, lapack_complex_double* z, + lapack_int ldz, lapack_complex_double* res, + lapack_complex_double* b, lapack_int ldb, + lapack_complex_double* w, lapack_int ldw, + lapack_complex_double* s, lapack_int lds, + lapack_complex_double* work, lapack_int lwork, + lapack_complex_double* iwork, lapack_int liwork ) +{ + lapack_int info = 0; + if( matrix_layout == LAPACK_COL_MAJOR ) { + /* Call LAPACK function and adjust info */ + LAPACK_zgedmd( &jobs, &jobz, &jobf, &whtsvd, &m, &n, x, &ldx, y, &ldy, + &k, reig, imeig, z, &ldz, res, b, &ldb, w, &ldw, s, &lds, + work, &lwork, iwork, &liwork, &info ); + if( info < 0 ) { + info = info - 1; + } + } else if( matrix_layout == LAPACK_ROW_MAJOR ) { + lapack_int ldx_t = MAX(1,m); + lapack_int ldy_t = MAX(1,m); + lapack_int ldz_t = MAX(1,m); + lapack_int ldb_t = MAX(1,m); + lapack_int ldw_t = MAX(1,m); + lapack_int lds_t = MAX(1,m); + lapack_complex_double* x_t = NULL; + lapack_complex_double* y_t = NULL; + lapack_complex_double* z_t = NULL; + lapack_complex_double* b_t = NULL; + lapack_complex_double* w_t = NULL; + lapack_complex_double* s_t = NULL; + /* Check leading dimension(s) */ + if( ldx < n ) { + info = -5; + LAPACKE_xerbla( "LAPACKE_zgedmd_work", info ); + return info; + } + if( ldy < n ) { + info = -5; + LAPACKE_xerbla( "LAPACKE_zgedmd_work", info ); + return info; + } + if( ldz < n ) { + info = -5; + LAPACKE_xerbla( "LAPACKE_zgedmd_work", info ); + return info; + } + if( ldb < n ) { + info = -5; + LAPACKE_xerbla( "LAPACKE_zgedmd_work", info ); + return info; + } + if( ldw < n ) { + info = -5; + LAPACKE_xerbla( "LAPACKE_zgedmd_work", info ); + return info; + } + if( lds < n ) { + info = -5; + LAPACKE_xerbla( "LAPACKE_zgedmd_work", info ); + return info; + } + /* Query optimal working array(s) size if requested */ + if( lwork == -1 ) { + LAPACK_zgedmd( &jobs, &jobz, &jobf, &whtsvd, &m, &n, x, &ldx, y, &ldy, + &k, reig, imeig, z, &ldz, res, b, &ldb, w, &ldw, s, &lds, + work, &lwork, iwork, &liwork, &info ); + return (info < 0) ? (info - 1) : info; + } + /* Allocate memory for temporary array(s) */ + x_t = (lapack_complex_double*)LAPACKE_malloc( sizeof(lapack_complex_double) * ldx_t * MAX(1,n) ); + y_t = (lapack_complex_double*)LAPACKE_malloc( sizeof(lapack_complex_double) * ldy_t * MAX(1,n) ); + z_t = (lapack_complex_double*)LAPACKE_malloc( sizeof(lapack_complex_double) * ldz_t * MAX(1,n) ); + b_t = (lapack_complex_double*)LAPACKE_malloc( sizeof(lapack_complex_double) * ldb_t * MAX(1,n) ); + w_t = (lapack_complex_double*)LAPACKE_malloc( sizeof(lapack_complex_double) * ldw_t * MAX(1,n) ); + s_t = (lapack_complex_double*)LAPACKE_malloc( sizeof(lapack_complex_double) * lds_t * MAX(1,n) ); + if( x_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_0; + } + if( y_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_0; + } + if( z_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_0; + } + if( b_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_0; + } + if( w_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_0; + } + if( s_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_0; + } + /* Transpose input matrices */ + LAPACKE_zge_trans( matrix_layout, m, n, x, ldx, x_t, ldx_t ); + LAPACKE_zge_trans( matrix_layout, m, n, y, ldy, y_t, ldy_t ); + LAPACKE_zge_trans( matrix_layout, m, n, z, ldz, z_t, ldz_t ); + LAPACKE_zge_trans( matrix_layout, m, n, b, ldb, b_t, ldb_t ); + LAPACKE_zge_trans( matrix_layout, m, n, w, ldw, w_t, ldw_t ); + LAPACKE_zge_trans( matrix_layout, m, n, s, lds, s_t, lds_t ); + /* Call LAPACK function and adjust info */ + LAPACK_zgedmd( &jobs, &jobz, &jobf, &whtsvd, &m, &n, x_t, &ldx_t, y_t, + &ldy_t, &k, reig, imeig, z_t, &ldz_t, res, b_t, &ldb_t, + w_t, &ldw_t, s_t, &lds_t, work, &lwork, iwork, &liwork, &info ); + if( info < 0 ) { + info = info - 1; + } + /* Transpose output matrices */ + LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, x_t, ldx_t, x, ldx ); + LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, y_t, ldy_t, y, ldy ); + LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, z_t, ldz_t, z, ldz ); + LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb ); + LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, w_t, ldw_t, w, ldw ); + LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, s_t, lds_t, s, lds ); + /* Release memory and exit */ + LAPACKE_free( x_t ); + LAPACKE_free( y_t ); + LAPACKE_free( z_t ); + LAPACKE_free( b_t ); + LAPACKE_free( w_t ); + LAPACKE_free( s_t ); +exit_level_0: + if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_zgedmd_work", info ); + } + } else { + info = -1; + LAPACKE_xerbla( "LAPACKE_zgedmd_work", info ); + } + return info; +}