phynexis-deps/lapack
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Adding lapacke wrappers for dmd routines - dmdq is needed yet

Browse Source
This commit is contained in:
Daniel Bielich
2023-03-24 11:04:17 -04:00
parent e52daa3151
commit fbd853cc3a
13 changed files with 1287 additions and 9 deletions
Download Patch File Download Diff File Expand all files Collapse all files
.gitignore
+1
View File
@@ -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
LAPACKE/include/lapack.h
+60
View File
@@ -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,
LAPACKE/include/lapacke.h
+61 -9
View File
@@ -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 );
LAPACKE/src/CMakeLists.txt
+8
View File
@@ -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
LAPACKE/src/Makefile
+8
View File
@@ -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 \
LAPACKE/src/lapacke_cgedmd.c
+114
View File
@@ -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;
}
LAPACKE/src/lapacke_cgedmd_work.c
+175
View File
@@ -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;
}
LAPACKE/src/lapacke_dgedmd.c
+111
View File
@@ -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;
}
LAPACKE/src/lapacke_dgedmd_work.c
+173
View File
@@ -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;
}
LAPACKE/src/lapacke_sgedmd.c
+111
View File
@@ -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;
}
LAPACKE/src/lapacke_sgedmd_work.c
+173
View File
@@ -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;
}
LAPACKE/src/lapacke_zgedmd.c
+115
View File
@@ -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;
}
LAPACKE/src/lapacke_zgedmd_work.c
+177
View File
@@ -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;
}