| @@ -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 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_int* iwork = NULL; | |||
| lapack_complex_float work_query; | |||
| lapack_int 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 -8; | |||
| } | |||
| if( LAPACKE_cge_nancheck( matrix_layout, m, n, y, ldy ) ) { | |||
| return -10; | |||
| } | |||
| if( LAPACKE_cge_nancheck( matrix_layout, m, n, z, ldz ) ) { | |||
| return -15; | |||
| } | |||
| if( LAPACKE_cge_nancheck( matrix_layout, m, n, b, ldb ) ) { | |||
| return -18; | |||
| } | |||
| if( LAPACKE_cge_nancheck( matrix_layout, m, n, w, ldw ) ) { | |||
| return -20; | |||
| } | |||
| if( LAPACKE_cge_nancheck( matrix_layout, m, n, s, lds ) ) { | |||
| return -22; | |||
| } | |||
| } | |||
| #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_C2INT( work_query ); | |||
| liwork = iwork_query; | |||
| /* Allocate memory for work arrays */ | |||
| work = (lapack_complex_float*)LAPACKE_malloc( sizeof(lapack_complex_float) * lwork ); | |||
| if( work == NULL ) { | |||
| info = LAPACK_WORK_MEMORY_ERROR; | |||
| goto exit_level_0; | |||
| } | |||
| iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork ); | |||
| if( iwork == NULL ) { | |||
| info = LAPACK_WORK_MEMORY_ERROR; | |||
| goto exit_level_1; | |||
| } | |||
| /* 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( iwork ); | |||
| exit_level_1: | |||
| LAPACKE_free( work ); | |||
| exit_level_0: | |||
| if( info == LAPACK_WORK_MEMORY_ERROR ) { | |||
| LAPACKE_xerbla( "LAPACKE_cgedmd", info ); | |||
| } | |||
| return info; | |||
| } | |||
| @@ -0,0 +1,180 @@ | |||
| /***************************************************************************** | |||
| 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_int* 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 = -9; | |||
| LAPACKE_xerbla( "LAPACKE_cgedmd_work", info ); | |||
| return info; | |||
| } | |||
| if( ldy < n ) { | |||
| info = -11; | |||
| LAPACKE_xerbla( "LAPACKE_cgedmd_work", info ); | |||
| return info; | |||
| } | |||
| if( ldz < n ) { | |||
| info = -16; | |||
| LAPACKE_xerbla( "LAPACKE_cgedmd_work", info ); | |||
| return info; | |||
| } | |||
| if( ldb < n ) { | |||
| info = -19; | |||
| LAPACKE_xerbla( "LAPACKE_cgedmd_work", info ); | |||
| return info; | |||
| } | |||
| if( ldw < n ) { | |||
| info = -21; | |||
| LAPACKE_xerbla( "LAPACKE_cgedmd_work", info ); | |||
| return info; | |||
| } | |||
| if( lds < n ) { | |||
| info = -23; | |||
| 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) ); | |||
| if( x_t == NULL ) { | |||
| info = LAPACK_TRANSPOSE_MEMORY_ERROR; | |||
| goto exit_level_0; | |||
| } | |||
| y_t = (lapack_complex_float*)LAPACKE_malloc( sizeof(lapack_complex_float) * ldy_t * MAX(1,n) ); | |||
| if( y_t == NULL ) { | |||
| info = LAPACK_TRANSPOSE_MEMORY_ERROR; | |||
| goto exit_level_1; | |||
| } | |||
| z_t = (lapack_complex_float*)LAPACKE_malloc( sizeof(lapack_complex_float) * ldz_t * MAX(1,n) ); | |||
| if( z_t == NULL ) { | |||
| info = LAPACK_TRANSPOSE_MEMORY_ERROR; | |||
| goto exit_level_2; | |||
| } | |||
| b_t = (lapack_complex_float*)LAPACKE_malloc( sizeof(lapack_complex_float) * ldb_t * MAX(1,n) ); | |||
| if( b_t == NULL ) { | |||
| info = LAPACK_TRANSPOSE_MEMORY_ERROR; | |||
| goto exit_level_3; | |||
| } | |||
| w_t = (lapack_complex_float*)LAPACKE_malloc( sizeof(lapack_complex_float) * ldw_t * MAX(1,n) ); | |||
| if( w_t == NULL ) { | |||
| info = LAPACK_TRANSPOSE_MEMORY_ERROR; | |||
| goto exit_level_4; | |||
| } | |||
| s_t = (lapack_complex_float*)LAPACKE_malloc( sizeof(lapack_complex_float) * lds_t * MAX(1,n) ); | |||
| if( s_t == NULL ) { | |||
| info = LAPACK_TRANSPOSE_MEMORY_ERROR; | |||
| goto exit_level_5; | |||
| } | |||
| /* 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( s_t ); | |||
| exit_level_5: | |||
| LAPACKE_free( w_t ); | |||
| exit_level_4: | |||
| LAPACKE_free( b_t ); | |||
| exit_level_3: | |||
| LAPACKE_free( z_t ); | |||
| exit_level_2: | |||
| LAPACKE_free( y_t ); | |||
| exit_level_1: | |||
| LAPACKE_free( x_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; | |||
| } | |||
| @@ -0,0 +1,123 @@ | |||
| /***************************************************************************** | |||
| 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 cgedmdq | |||
| * Author: Intel Corporation | |||
| *****************************************************************************/ | |||
| #include "lapacke_utils.h" | |||
| lapack_int LAPACKE_cgedmdq( int matrix_layout, char jobs, char jobz, char jobr, | |||
| char jobq, char jobt, char jobf, lapack_int whtsvd, | |||
| lapack_int m, lapack_int n, lapack_complex_float* f, | |||
| lapack_int ldf, lapack_complex_float* x, | |||
| lapack_int ldx, lapack_complex_float* y, | |||
| lapack_int ldy, lapack_int nrnk, float tol, | |||
| 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* v, | |||
| lapack_int ldv, 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_int* iwork = NULL; | |||
| lapack_complex_float work_query; | |||
| lapack_int iwork_query; | |||
| if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { | |||
| LAPACKE_xerbla( "LAPACKE_cgedmdq", -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, f, ldf ) ) { | |||
| return -11; | |||
| } | |||
| if( LAPACKE_cge_nancheck( matrix_layout, m, n, x, ldx ) ) { | |||
| return -13; | |||
| } | |||
| if( LAPACKE_cge_nancheck( matrix_layout, m, n, y, ldy ) ) { | |||
| return -15; | |||
| } | |||
| if( LAPACKE_cge_nancheck( matrix_layout, m, n, z, ldz ) ) { | |||
| return -22; | |||
| } | |||
| if( LAPACKE_cge_nancheck( matrix_layout, m, n, b, ldb ) ) { | |||
| return -25; | |||
| } | |||
| if( LAPACKE_cge_nancheck( matrix_layout, m, n, v, ldv ) ) { | |||
| return -27; | |||
| } | |||
| if( LAPACKE_cge_nancheck( matrix_layout, m, n, s, lds ) ) { | |||
| return -29; | |||
| } | |||
| } | |||
| #endif | |||
| /* Query optimal working array(s) size */ | |||
| info = LAPACKE_cgedmdq_work( matrix_layout, jobs, jobz, jobr, jobq, jobt, | |||
| jobf, whtsvd, m, n, f, ldf, x, ldx, y, ldy, | |||
| nrnk, tol, k, reig, imeig, z, ldz, res, | |||
| b, ldb, v, ldv, s, lds, &work_query, lwork, | |||
| &iwork_query, liwork ); | |||
| if( info != 0 ) { | |||
| goto exit_level_0; | |||
| } | |||
| lwork = LAPACK_C2INT( work_query ); | |||
| liwork = iwork_query; | |||
| /* Allocate memory for work arrays */ | |||
| work = (lapack_complex_float*)LAPACKE_malloc( sizeof(lapack_complex_float) * lwork ); | |||
| if( work == NULL ) { | |||
| info = LAPACK_WORK_MEMORY_ERROR; | |||
| goto exit_level_0; | |||
| } | |||
| iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork ); | |||
| if( iwork == NULL ) { | |||
| info = LAPACK_WORK_MEMORY_ERROR; | |||
| goto exit_level_1; | |||
| } | |||
| /* Call middle-level interface */ | |||
| info = LAPACKE_cgedmdq_work( matrix_layout, jobs, jobz, jobr, jobq, jobt, | |||
| jobf, whtsvd, m, n, f, ldf, x, ldx, y, ldy, | |||
| nrnk, tol, k, reig, imeig, z, ldz, res, | |||
| b, ldb, v, ldv, s, lds, work, lwork, iwork, | |||
| liwork ); | |||
| /* Release memory and exit */ | |||
| LAPACKE_free( iwork ); | |||
| exit_level_1: | |||
| LAPACKE_free( work ); | |||
| exit_level_0: | |||
| if( info == LAPACK_WORK_MEMORY_ERROR ) { | |||
| LAPACKE_xerbla( "LAPACKE_cgedmdq", info ); | |||
| } | |||
| return info; | |||
| } | |||
| @@ -0,0 +1,205 @@ | |||
| /***************************************************************************** | |||
| 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 cgedmdq | |||
| * Author: Intel Corporation | |||
| *****************************************************************************/ | |||
| #include "lapacke_utils.h" | |||
| lapack_int LAPACKE_cgedmdq_work( int matrix_layout, char jobs, char jobz, | |||
| char jobr, char jobq, char jobt, char jobf, | |||
| lapack_int whtsvd, lapack_int m, lapack_int n, | |||
| lapack_complex_float* f, lapack_int ldf, | |||
| lapack_complex_float* x, lapack_int ldx, | |||
| lapack_complex_float* y, lapack_int ldy, | |||
| lapack_int nrnk, float tol, 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* v, | |||
| lapack_int ldv, lapack_complex_float* s, | |||
| lapack_int lds, lapack_complex_float* work, | |||
| lapack_int lwork, lapack_int* iwork, | |||
| lapack_int liwork ) | |||
| { | |||
| lapack_int info = 0; | |||
| if( matrix_layout == LAPACK_COL_MAJOR ) { | |||
| /* Call LAPACK function and adjust info */ | |||
| LAPACK_cgedmdq( &jobs, &jobz, &jobr, &jobq, &jobt, &jobf, &whtsvd, &m, | |||
| &n, f, &ldf, x, &ldx, y, &ldy, &nrnk, &tol, &k, reig, | |||
| imeig, z, &ldz, res, b, &ldb, v, &ldv, s, &lds, | |||
| work, &lwork, iwork, &liwork, &info ); | |||
| if( info < 0 ) { | |||
| info = info - 1; | |||
| } | |||
| } else if( matrix_layout == LAPACK_ROW_MAJOR ) { | |||
| lapack_int ldf_t = MAX(1,m); | |||
| 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 ldv_t = MAX(1,m); | |||
| lapack_int lds_t = MAX(1,m); | |||
| lapack_complex_float* f_t = NULL; | |||
| 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* v_t = NULL; | |||
| lapack_complex_float* s_t = NULL; | |||
| /* Check leading dimension(s) */ | |||
| if( ldf < n ) { | |||
| info = -12; | |||
| LAPACKE_xerbla( "LAPACKE_cgedmdq_work", info ); | |||
| return info; | |||
| } | |||
| if( ldx < n ) { | |||
| info = -14; | |||
| LAPACKE_xerbla( "LAPACKE_cgedmdq_work", info ); | |||
| return info; | |||
| } | |||
| if( ldy < n ) { | |||
| info = -16; | |||
| LAPACKE_xerbla( "LAPACKE_cgedmdq_work", info ); | |||
| return info; | |||
| } | |||
| if( ldz < n ) { | |||
| info = -23; | |||
| LAPACKE_xerbla( "LAPACKE_cgedmdq_work", info ); | |||
| return info; | |||
| } | |||
| if( ldb < n ) { | |||
| info = -26; | |||
| LAPACKE_xerbla( "LAPACKE_cgedmdq_work", info ); | |||
| return info; | |||
| } | |||
| if( ldv < n ) { | |||
| info = -28; | |||
| LAPACKE_xerbla( "LAPACKE_cgedmdq_work", info ); | |||
| return info; | |||
| } | |||
| if( lds < n ) { | |||
| info = -30; | |||
| LAPACKE_xerbla( "LAPACKE_cgedmdq_work", info ); | |||
| return info; | |||
| } | |||
| /* Query optimal working array(s) size if requested */ | |||
| if( lwork == -1 || liwork == -1 ) { | |||
| LAPACK_cgedmdq( &jobs, &jobz, &jobr, &jobq, &jobt, &jobf, &whtsvd, &m, | |||
| &n, f, &ldf, x, &ldx, y, &ldy, &nrnk, &tol, &k, reig, | |||
| imeig, z, &ldz, res, b, &ldb, v, &ldv, s, &lds, | |||
| work, &lwork, iwork, &liwork, &info ); | |||
| return (info < 0) ? (info - 1) : info; | |||
| } | |||
| /* Allocate memory for temporary array(s) */ | |||
| f_t = (lapack_complex_float*)LAPACKE_malloc( sizeof(lapack_complex_float) * ldf_t * MAX(1,n) ); | |||
| if( f_t == NULL ) { | |||
| info = LAPACK_TRANSPOSE_MEMORY_ERROR; | |||
| goto exit_level_0; | |||
| } | |||
| x_t = (lapack_complex_float*)LAPACKE_malloc( sizeof(lapack_complex_float) * ldx_t * MAX(1,n) ); | |||
| if( x_t == NULL ) { | |||
| info = LAPACK_TRANSPOSE_MEMORY_ERROR; | |||
| goto exit_level_1; | |||
| } | |||
| y_t = (lapack_complex_float*)LAPACKE_malloc( sizeof(lapack_complex_float) * ldy_t * MAX(1,n) ); | |||
| if( y_t == NULL ) { | |||
| info = LAPACK_TRANSPOSE_MEMORY_ERROR; | |||
| goto exit_level_2; | |||
| } | |||
| z_t = (lapack_complex_float*)LAPACKE_malloc( sizeof(lapack_complex_float) * ldz_t * MAX(1,n) ); | |||
| if( z_t == NULL ) { | |||
| info = LAPACK_TRANSPOSE_MEMORY_ERROR; | |||
| goto exit_level_3; | |||
| } | |||
| b_t = (lapack_complex_float*)LAPACKE_malloc( sizeof(lapack_complex_float) * ldb_t * MAX(1,n) ); | |||
| if( b_t == NULL ) { | |||
| info = LAPACK_TRANSPOSE_MEMORY_ERROR; | |||
| goto exit_level_4; | |||
| } | |||
| v_t = (lapack_complex_float*)LAPACKE_malloc( sizeof(lapack_complex_float) * ldv_t * MAX(1,n) ); | |||
| if( v_t == NULL ) { | |||
| info = LAPACK_TRANSPOSE_MEMORY_ERROR; | |||
| goto exit_level_5; | |||
| } | |||
| s_t = (lapack_complex_float*)LAPACKE_malloc( sizeof(lapack_complex_float) * lds_t * MAX(1,n) ); | |||
| if( s_t == NULL ) { | |||
| info = LAPACK_TRANSPOSE_MEMORY_ERROR; | |||
| goto exit_level_6; | |||
| } | |||
| /* Transpose input matrices */ | |||
| LAPACKE_cge_trans( matrix_layout, m, n, f, ldf, f_t, ldf_t ); | |||
| 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, v, ldv, v_t, ldv_t ); | |||
| LAPACKE_cge_trans( matrix_layout, m, n, s, lds, s_t, lds_t ); | |||
| /* Call LAPACK function and adjust info */ | |||
| LAPACK_cgedmdq( &jobs, &jobz, &jobr, &jobq, &jobt, &jobf, &whtsvd, &m, | |||
| &n, f, &ldf, x, &ldx, y, &ldy, &nrnk, &tol, &k, reig, | |||
| imeig, z, &ldz, res, b, &ldb, v, &ldv, s, &lds, | |||
| work, &lwork, iwork, &liwork, &info ); | |||
| if( info < 0 ) { | |||
| info = info - 1; | |||
| } | |||
| /* Transpose output matrices */ | |||
| LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, f_t, ldf_t, f, ldf ); | |||
| 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, v_t, ldv_t, v, ldv ); | |||
| LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, s_t, lds_t, s, lds ); | |||
| /* Release memory and exit */ | |||
| LAPACKE_free( s_t ); | |||
| exit_level_6: | |||
| LAPACKE_free( v_t ); | |||
| exit_level_5: | |||
| LAPACKE_free( b_t ); | |||
| exit_level_4: | |||
| LAPACKE_free( z_t ); | |||
| exit_level_3: | |||
| LAPACKE_free( y_t ); | |||
| exit_level_2: | |||
| LAPACKE_free( x_t ); | |||
| exit_level_1: | |||
| LAPACKE_free( f_t ); | |||
| exit_level_0: | |||
| if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { | |||
| LAPACKE_xerbla( "LAPACKE_cgedmdq_work", info ); | |||
| } | |||
| } else { | |||
| info = -1; | |||
| LAPACKE_xerbla( "LAPACKE_cgedmdq_work", info ); | |||
| } | |||
| return info; | |||
| } | |||
| @@ -0,0 +1,112 @@ | |||
| /***************************************************************************** | |||
| Copyright (c) 2014, Intel Corp. | |||
| All rights reserved. | |||
| Redistribution and use in source and binary forms, with or without | |||
| modification, are permitted provided that the following conditions are met: | |||
| * Redistributions of source code must retain the above copyright notice, | |||
| this list of conditions and the following disclaimer. | |||
| * Redistributions in binary form must reproduce the above copyright | |||
| notice, this list of conditions and the following disclaimer in the | |||
| documentation and/or other materials provided with the distribution. | |||
| * Neither the name of Intel Corporation nor the names of its contributors | |||
| may be used to endorse or promote products derived from this software | |||
| without specific prior written permission. | |||
| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" | |||
| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE | |||
| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE | |||
| ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE | |||
| LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR | |||
| CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF | |||
| SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS | |||
| INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN | |||
| CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) | |||
| ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF | |||
| THE POSSIBILITY OF SUCH DAMAGE. | |||
| ***************************************************************************** | |||
| * Contents: Native 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; | |||
| lapack_int* iwork = NULL; | |||
| double work_query; | |||
| lapack_int 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 -8; | |||
| } | |||
| if( LAPACKE_dge_nancheck( matrix_layout, m, n, y, ldy ) ) { | |||
| return -10; | |||
| } | |||
| if( LAPACKE_dge_nancheck( matrix_layout, m, n, z, ldz ) ) { | |||
| return -15; | |||
| } | |||
| if( LAPACKE_dge_nancheck( matrix_layout, m, n, b, ldb ) ) { | |||
| return -18; | |||
| } | |||
| if( LAPACKE_dge_nancheck( matrix_layout, m, n, s, lds ) ) { | |||
| return -20; | |||
| } | |||
| if( LAPACKE_dge_nancheck( matrix_layout, m, n, w, ldw ) ) { | |||
| return -22; | |||
| } | |||
| } | |||
| #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 = iwork_query; | |||
| /* Allocate memory for work arrays */ | |||
| work = (double*)LAPACKE_malloc( sizeof(double) * lwork ); | |||
| if( work == NULL ) { | |||
| info = LAPACK_WORK_MEMORY_ERROR; | |||
| goto exit_level_0; | |||
| } | |||
| iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork ); | |||
| if( iwork == NULL ) { | |||
| info = LAPACK_WORK_MEMORY_ERROR; | |||
| goto exit_level_1; | |||
| } | |||
| /* 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( iwork ); | |||
| exit_level_1: | |||
| LAPACKE_free( work ); | |||
| exit_level_0: | |||
| if( info == LAPACK_WORK_MEMORY_ERROR ) { | |||
| LAPACKE_xerbla( "LAPACKE_dgedmd", info ); | |||
| } | |||
| return info; | |||
| } | |||
| @@ -0,0 +1,179 @@ | |||
| /***************************************************************************** | |||
| Copyright (c) 2014, Intel Corp. | |||
| All rights reserved. | |||
| Redistribution and use in source and binary forms, with or without | |||
| modification, are permitted provided that the following conditions are met: | |||
| * Redistributions of source code must retain the above copyright notice, | |||
| this list of conditions and the following disclaimer. | |||
| * Redistributions in binary form must reproduce the above copyright | |||
| notice, this list of conditions and the following disclaimer in the | |||
| documentation and/or other materials provided with the distribution. | |||
| * Neither the name of Intel Corporation nor the names of its contributors | |||
| may be used to endorse or promote products derived from this software | |||
| without specific prior written permission. | |||
| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" | |||
| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE | |||
| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE | |||
| ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE | |||
| LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR | |||
| CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF | |||
| SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS | |||
| INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN | |||
| CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) | |||
| ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF | |||
| THE POSSIBILITY OF SUCH DAMAGE. | |||
| ***************************************************************************** | |||
| * Contents: Native middle-level C interface to LAPACK function 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, lapack_int* 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 = -9; | |||
| LAPACKE_xerbla( "LAPACKE_dgedmd_work", info ); | |||
| return info; | |||
| } | |||
| if( ldy < n ) { | |||
| info = -11; | |||
| LAPACKE_xerbla( "LAPACKE_dgedmd_work", info ); | |||
| return info; | |||
| } | |||
| if( ldz < n ) { | |||
| info = -16; | |||
| LAPACKE_xerbla( "LAPACKE_dgedmd_work", info ); | |||
| return info; | |||
| } | |||
| if( ldb < n ) { | |||
| info = -19; | |||
| LAPACKE_xerbla( "LAPACKE_dgedmd_work", info ); | |||
| return info; | |||
| } | |||
| if( ldw < n ) { | |||
| info = -21; | |||
| LAPACKE_xerbla( "LAPACKE_dgedmd_work", info ); | |||
| return info; | |||
| } | |||
| if( lds < n ) { | |||
| info = -23; | |||
| 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) ); | |||
| if( x_t == NULL ) { | |||
| info = LAPACK_TRANSPOSE_MEMORY_ERROR; | |||
| goto exit_level_0; | |||
| } | |||
| y_t = (double*)LAPACKE_malloc( sizeof(double) * ldy_t * MAX(1,n) ); | |||
| if( y_t == NULL ) { | |||
| info = LAPACK_TRANSPOSE_MEMORY_ERROR; | |||
| goto exit_level_1; | |||
| } | |||
| z_t = (double*)LAPACKE_malloc( sizeof(double) * ldz_t * MAX(1,n) ); | |||
| if( z_t == NULL ) { | |||
| info = LAPACK_TRANSPOSE_MEMORY_ERROR; | |||
| goto exit_level_2; | |||
| } | |||
| b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,n) ); | |||
| if( b_t == NULL ) { | |||
| info = LAPACK_TRANSPOSE_MEMORY_ERROR; | |||
| goto exit_level_3; | |||
| } | |||
| w_t = (double*)LAPACKE_malloc( sizeof(double) * ldw_t * MAX(1,n) ); | |||
| if( w_t == NULL ) { | |||
| info = LAPACK_TRANSPOSE_MEMORY_ERROR; | |||
| goto exit_level_4; | |||
| } | |||
| s_t = (double*)LAPACKE_malloc( sizeof(double) * lds_t * MAX(1,n) ); | |||
| if( s_t == NULL ) { | |||
| info = LAPACK_TRANSPOSE_MEMORY_ERROR; | |||
| goto exit_level_5; | |||
| } | |||
| /* 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( s_t ); | |||
| exit_level_5: | |||
| LAPACKE_free( w_t ); | |||
| exit_level_4: | |||
| LAPACKE_free( b_t ); | |||
| exit_level_3: | |||
| LAPACKE_free( z_t ); | |||
| exit_level_2: | |||
| LAPACKE_free( y_t ); | |||
| exit_level_1: | |||
| LAPACKE_free( x_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; | |||
| } | |||
| @@ -0,0 +1,119 @@ | |||
| /***************************************************************************** | |||
| Copyright (c) 2014, Intel Corp. | |||
| All rights reserved. | |||
| Redistribution and use in source and binary forms, with or without | |||
| modification, are permitted provided that the following conditions are met: | |||
| * Redistributions of source code must retain the above copyright notice, | |||
| this list of conditions and the following disclaimer. | |||
| * Redistributions in binary form must reproduce the above copyright | |||
| notice, this list of conditions and the following disclaimer in the | |||
| documentation and/or other materials provided with the distribution. | |||
| * Neither the name of Intel Corporation nor the names of its contributors | |||
| may be used to endorse or promote products derived from this software | |||
| without specific prior written permission. | |||
| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" | |||
| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE | |||
| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE | |||
| ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE | |||
| LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR | |||
| CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF | |||
| SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS | |||
| INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN | |||
| CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) | |||
| ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF | |||
| THE POSSIBILITY OF SUCH DAMAGE. | |||
| ***************************************************************************** | |||
| * Contents: Native high-level C interface to LAPACK function dgedmdq | |||
| * Author: Intel Corporation | |||
| *****************************************************************************/ | |||
| #include "lapacke_utils.h" | |||
| lapack_int LAPACKE_dgedmdq( int matrix_layout, char jobs, char jobz, char jobr, | |||
| char jobq, char jobt, char jobf, lapack_int whtsvd, | |||
| lapack_int m, lapack_int n, double* f, lapack_int ldf, | |||
| double* x, lapack_int ldx, double* y, lapack_int ldy, | |||
| lapack_int nrnk, double tol, lapack_int k, | |||
| double* reig, double* imeig, double* z, | |||
| lapack_int ldz, double* res, double* b, lapack_int ldb, | |||
| double* v, lapack_int ldv, double* s, lapack_int lds) | |||
| { | |||
| lapack_int info = 0; | |||
| lapack_int lwork = -1; | |||
| lapack_int liwork = -1; | |||
| double* work = NULL; | |||
| lapack_int* iwork = NULL; | |||
| double work_query; | |||
| lapack_int iwork_query; | |||
| if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { | |||
| LAPACKE_xerbla( "LAPACKE_dgedmdq", -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, f, ldf ) ) { | |||
| return -11; | |||
| } | |||
| if( LAPACKE_dge_nancheck( matrix_layout, m, n, x, ldx ) ) { | |||
| return -13; | |||
| } | |||
| if( LAPACKE_dge_nancheck( matrix_layout, m, n, y, ldy ) ) { | |||
| return -15; | |||
| } | |||
| if( LAPACKE_dge_nancheck( matrix_layout, m, n, z, ldz ) ) { | |||
| return -22; | |||
| } | |||
| if( LAPACKE_dge_nancheck( matrix_layout, m, n, b, ldb ) ) { | |||
| return -25; | |||
| } | |||
| if( LAPACKE_dge_nancheck( matrix_layout, m, n, v, ldv ) ) { | |||
| return -27; | |||
| } | |||
| if( LAPACKE_dge_nancheck( matrix_layout, m, n, s, lds ) ) { | |||
| return -29; | |||
| } | |||
| } | |||
| #endif | |||
| /* Query optimal working array(s) size */ | |||
| info = LAPACKE_dgedmdq_work( matrix_layout, jobs, jobz, jobr, jobq, jobt, | |||
| jobf, whtsvd, m, n, f, ldf, x, ldx, y, ldy, | |||
| nrnk, tol, k, reig, imeig, z, ldz, res, | |||
| b, ldb, v, ldv, s, lds, &work_query, lwork, | |||
| &iwork_query, liwork ); | |||
| if( info != 0 ) { | |||
| goto exit_level_0; | |||
| } | |||
| lwork = (lapack_int) work_query; | |||
| liwork = iwork_query; | |||
| /* Allocate memory for work arrays */ | |||
| work = (double*)LAPACKE_malloc( sizeof(double) * lwork ); | |||
| if( work == NULL ) { | |||
| info = LAPACK_WORK_MEMORY_ERROR; | |||
| goto exit_level_0; | |||
| } | |||
| iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork ); | |||
| if( iwork == NULL ) { | |||
| info = LAPACK_WORK_MEMORY_ERROR; | |||
| goto exit_level_1; | |||
| } | |||
| /* Call middle-level interface */ | |||
| info = LAPACKE_dgedmdq_work( matrix_layout, jobs, jobz, jobr, jobq, jobt, | |||
| jobf, whtsvd, m, n, f, ldf, x, ldx, y, ldy, | |||
| nrnk, tol, k, reig, imeig, z, ldz, res, | |||
| b, ldb, v, ldv, s, lds, work, lwork, iwork, | |||
| liwork ); | |||
| /* Release memory and exit */ | |||
| LAPACKE_free( iwork ); | |||
| exit_level_1: | |||
| LAPACKE_free( work ); | |||
| exit_level_0: | |||
| if( info == LAPACK_WORK_MEMORY_ERROR ) { | |||
| LAPACKE_xerbla( "LAPACKE_dgedmdq", info ); | |||
| } | |||
| return info; | |||
| } | |||
| @@ -0,0 +1,200 @@ | |||
| /***************************************************************************** | |||
| 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 dgedmdq | |||
| * Author: Intel Corporation | |||
| *****************************************************************************/ | |||
| #include "lapacke_utils.h" | |||
| lapack_int LAPACKE_dgedmdq_work( int matrix_layout, char jobs, char jobz, | |||
| char jobr, char jobq, char jobt, char jobf, | |||
| lapack_int whtsvd, lapack_int m, lapack_int n, | |||
| double* f, lapack_int ldf, double* x, | |||
| lapack_int ldx, double* y, lapack_int ldy, | |||
| lapack_int nrnk, double tol, lapack_int k, | |||
| double* reig, double* imeig, double* z, | |||
| lapack_int ldz, double* res, double* b, | |||
| lapack_int ldb, double* v, lapack_int ldv, | |||
| double* s, lapack_int lds, double* work, | |||
| lapack_int lwork, lapack_int* iwork, | |||
| lapack_int liwork ) | |||
| { | |||
| lapack_int info = 0; | |||
| if( matrix_layout == LAPACK_COL_MAJOR ) { | |||
| /* Call LAPACK function and adjust info */ | |||
| LAPACK_dgedmdq( &jobs, &jobz, &jobr, &jobq, &jobt, &jobf, &whtsvd, &m, | |||
| &n, f, &ldf, x, &ldx, y, &ldy, &nrnk, &tol, &k, reig, | |||
| imeig, z, &ldz, res, b, &ldb, v, &ldv, s, &lds, | |||
| work, &lwork, iwork, &liwork, &info ); | |||
| if( info < 0 ) { | |||
| info = info - 1; | |||
| } | |||
| } else if( matrix_layout == LAPACK_ROW_MAJOR ) { | |||
| lapack_int ldf_t = MAX(1,m); | |||
| 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 ldv_t = MAX(1,m); | |||
| lapack_int lds_t = MAX(1,m); | |||
| double* f_t = NULL; | |||
| double* x_t = NULL; | |||
| double* y_t = NULL; | |||
| double* z_t = NULL; | |||
| double* b_t = NULL; | |||
| double* v_t = NULL; | |||
| double* s_t = NULL; | |||
| /* Check leading dimension(s) */ | |||
| if( ldf < n ) { | |||
| info = -12; | |||
| LAPACKE_xerbla( "LAPACKE_dgedmdq_work", info ); | |||
| return info; | |||
| } | |||
| if( ldx < n ) { | |||
| info = -14; | |||
| LAPACKE_xerbla( "LAPACKE_dgedmdq_work", info ); | |||
| return info; | |||
| } | |||
| if( ldy < n ) { | |||
| info = -16; | |||
| LAPACKE_xerbla( "LAPACKE_dgedmdq_work", info ); | |||
| return info; | |||
| } | |||
| if( ldz < n ) { | |||
| info = -23; | |||
| LAPACKE_xerbla( "LAPACKE_dgedmdq_work", info ); | |||
| return info; | |||
| } | |||
| if( ldb < n ) { | |||
| info = -26; | |||
| LAPACKE_xerbla( "LAPACKE_dgedmdq_work", info ); | |||
| return info; | |||
| } | |||
| if( ldv < n ) { | |||
| info = -28; | |||
| LAPACKE_xerbla( "LAPACKE_dgedmdq_work", info ); | |||
| return info; | |||
| } | |||
| if( lds < n ) { | |||
| info = -30; | |||
| LAPACKE_xerbla( "LAPACKE_dgedmdq_work", info ); | |||
| return info; | |||
| } | |||
| /* Query optimal working array(s) size if requested */ | |||
| if( lwork == -1 || liwork == -1 ) { | |||
| LAPACK_dgedmdq( &jobs, &jobz, &jobr, &jobq, &jobt, &jobf, &whtsvd, &m, | |||
| &n, f, &ldf, x, &ldx, y, &ldy, &nrnk, &tol, &k, reig, | |||
| imeig, z, &ldz, res, b, &ldb, v, &ldv, s, &lds, | |||
| work, &lwork, iwork, &liwork, &info ); | |||
| return (info < 0) ? (info - 1) : info; | |||
| } | |||
| /* Allocate memory for temporary array(s) */ | |||
| f_t = (double*)LAPACKE_malloc( sizeof(double) * ldf_t * MAX(1,n) ); | |||
| if( f_t == NULL ) { | |||
| info = LAPACK_TRANSPOSE_MEMORY_ERROR; | |||
| goto exit_level_0; | |||
| } | |||
| x_t = (double*)LAPACKE_malloc( sizeof(double) * ldx_t * MAX(1,n) ); | |||
| if( x_t == NULL ) { | |||
| info = LAPACK_TRANSPOSE_MEMORY_ERROR; | |||
| goto exit_level_1; | |||
| } | |||
| y_t = (double*)LAPACKE_malloc( sizeof(double) * ldy_t * MAX(1,n) ); | |||
| if( y_t == NULL ) { | |||
| info = LAPACK_TRANSPOSE_MEMORY_ERROR; | |||
| goto exit_level_2; | |||
| } | |||
| z_t = (double*)LAPACKE_malloc( sizeof(double) * ldz_t * MAX(1,n) ); | |||
| if( z_t == NULL ) { | |||
| info = LAPACK_TRANSPOSE_MEMORY_ERROR; | |||
| goto exit_level_3; | |||
| } | |||
| b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,n) ); | |||
| if( b_t == NULL ) { | |||
| info = LAPACK_TRANSPOSE_MEMORY_ERROR; | |||
| goto exit_level_4; | |||
| } | |||
| v_t = (double*)LAPACKE_malloc( sizeof(double) * ldv_t * MAX(1,n) ); | |||
| if( v_t == NULL ) { | |||
| info = LAPACK_TRANSPOSE_MEMORY_ERROR; | |||
| goto exit_level_5; | |||
| } | |||
| s_t = (double*)LAPACKE_malloc( sizeof(double) * lds_t * MAX(1,n) ); | |||
| if( s_t == NULL ) { | |||
| info = LAPACK_TRANSPOSE_MEMORY_ERROR; | |||
| goto exit_level_6; | |||
| } | |||
| /* Transpose input matrices */ | |||
| LAPACKE_dge_trans( matrix_layout, m, n, f, ldf, f_t, ldf_t ); | |||
| 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, v, ldv, v_t, ldv_t ); | |||
| LAPACKE_dge_trans( matrix_layout, m, n, s, lds, s_t, lds_t ); | |||
| /* Call LAPACK function and adjust info */ | |||
| LAPACK_dgedmdq( &jobs, &jobz, &jobr, &jobq, &jobt, &jobf, &whtsvd, &m, | |||
| &n, f, &ldf, x, &ldx, y, &ldy, &nrnk, &tol, &k, reig, | |||
| imeig, z, &ldz, res, b, &ldb, v, &ldv, s, &lds, | |||
| work, &lwork, iwork, &liwork, &info ); | |||
| if( info < 0 ) { | |||
| info = info - 1; | |||
| } | |||
| /* Transpose output matrices */ | |||
| LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, f_t, ldf_t, f, ldf ); | |||
| 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, v_t, ldv_t, v, ldv ); | |||
| LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, s_t, lds_t, s, lds ); | |||
| /* Release memory and exit */ | |||
| LAPACKE_free( s_t ); | |||
| exit_level_6: | |||
| LAPACKE_free( v_t ); | |||
| exit_level_5: | |||
| LAPACKE_free( b_t ); | |||
| exit_level_4: | |||
| LAPACKE_free( z_t ); | |||
| exit_level_3: | |||
| LAPACKE_free( y_t ); | |||
| exit_level_2: | |||
| LAPACKE_free( x_t ); | |||
| exit_level_1: | |||
| LAPACKE_free( f_t ); | |||
| exit_level_0: | |||
| if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { | |||
| LAPACKE_xerbla( "LAPACKE_dgedmdq_work", info ); | |||
| } | |||
| } else { | |||
| info = -1; | |||
| LAPACKE_xerbla( "LAPACKE_dgedmdq_work", info ); | |||
| } | |||
| return info; | |||
| } | |||
| @@ -0,0 +1,112 @@ | |||
| /***************************************************************************** | |||
| Copyright (c) 2014, Intel Corp. | |||
| All rights reserved. | |||
| Redistribution and use in source and binary forms, with or without | |||
| modification, are permitted provided that the following conditions are met: | |||
| * Redistributions of source code must retain the above copyright notice, | |||
| this list of conditions and the following disclaimer. | |||
| * Redistributions in binary form must reproduce the above copyright | |||
| notice, this list of conditions and the following disclaimer in the | |||
| documentation and/or other materials provided with the distribution. | |||
| * Neither the name of Intel Corporation nor the names of its contributors | |||
| may be used to endorse or promote products derived from this software | |||
| without specific prior written permission. | |||
| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" | |||
| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE | |||
| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE | |||
| ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE | |||
| LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR | |||
| CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF | |||
| SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS | |||
| INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN | |||
| CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) | |||
| ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF | |||
| THE POSSIBILITY OF SUCH DAMAGE. | |||
| ***************************************************************************** | |||
| * Contents: Native 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; | |||
| lapack_int* iwork = NULL; | |||
| float work_query; | |||
| lapack_int 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 -8; | |||
| } | |||
| if( LAPACKE_sge_nancheck( matrix_layout, m, n, y, ldy ) ) { | |||
| return -10; | |||
| } | |||
| if( LAPACKE_sge_nancheck( matrix_layout, m, n, z, ldz ) ) { | |||
| return -15; | |||
| } | |||
| if( LAPACKE_sge_nancheck( matrix_layout, m, n, b, ldb ) ) { | |||
| return -18; | |||
| } | |||
| if( LAPACKE_sge_nancheck( matrix_layout, m, n, s, lds ) ) { | |||
| return -20; | |||
| } | |||
| if( LAPACKE_sge_nancheck( matrix_layout, m, n, w, ldw ) ) { | |||
| return -22; | |||
| } | |||
| } | |||
| #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 = iwork_query; | |||
| /* Allocate memory for work arrays */ | |||
| work = (float*)LAPACKE_malloc( sizeof(float) * lwork ); | |||
| if( work == NULL ) { | |||
| info = LAPACK_WORK_MEMORY_ERROR; | |||
| goto exit_level_0; | |||
| } | |||
| iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork ); | |||
| if( iwork == NULL ) { | |||
| info = LAPACK_WORK_MEMORY_ERROR; | |||
| goto exit_level_1; | |||
| } | |||
| /* 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( iwork ); | |||
| exit_level_1: | |||
| LAPACKE_free( work ); | |||
| exit_level_0: | |||
| if( info == LAPACK_WORK_MEMORY_ERROR ) { | |||
| LAPACKE_xerbla( "LAPACKE_sgedmd", info ); | |||
| } | |||
| return info; | |||
| } | |||
| @@ -0,0 +1,179 @@ | |||
| /***************************************************************************** | |||
| Copyright (c) 2014, Intel Corp. | |||
| All rights reserved. | |||
| Redistribution and use in source and binary forms, with or without | |||
| modification, are permitted provided that the following conditions are met: | |||
| * Redistributions of source code must retain the above copyright notice, | |||
| this list of conditions and the following disclaimer. | |||
| * Redistributions in binary form must reproduce the above copyright | |||
| notice, this list of conditions and the following disclaimer in the | |||
| documentation and/or other materials provided with the distribution. | |||
| * Neither the name of Intel Corporation nor the names of its contributors | |||
| may be used to endorse or promote products derived from this software | |||
| without specific prior written permission. | |||
| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" | |||
| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE | |||
| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE | |||
| ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE | |||
| LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR | |||
| CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF | |||
| SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS | |||
| INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN | |||
| CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) | |||
| ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF | |||
| THE POSSIBILITY OF SUCH DAMAGE. | |||
| ***************************************************************************** | |||
| * Contents: Native middle-level C interface to LAPACK function 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, lapack_int* 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 = -9; | |||
| LAPACKE_xerbla( "LAPACKE_sgedmd_work", info ); | |||
| return info; | |||
| } | |||
| if( ldy < n ) { | |||
| info = -11; | |||
| LAPACKE_xerbla( "LAPACKE_sgedmd_work", info ); | |||
| return info; | |||
| } | |||
| if( ldz < n ) { | |||
| info = -16; | |||
| LAPACKE_xerbla( "LAPACKE_sgedmd_work", info ); | |||
| return info; | |||
| } | |||
| if( ldb < n ) { | |||
| info = -19; | |||
| LAPACKE_xerbla( "LAPACKE_sgedmd_work", info ); | |||
| return info; | |||
| } | |||
| if( ldw < n ) { | |||
| info = -21; | |||
| LAPACKE_xerbla( "LAPACKE_sgedmd_work", info ); | |||
| return info; | |||
| } | |||
| if( lds < n ) { | |||
| info = -23; | |||
| 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) ); | |||
| if( x_t == NULL ) { | |||
| info = LAPACK_TRANSPOSE_MEMORY_ERROR; | |||
| goto exit_level_0; | |||
| } | |||
| y_t = (float*)LAPACKE_malloc( sizeof(float) * ldy_t * MAX(1,n) ); | |||
| if( y_t == NULL ) { | |||
| info = LAPACK_TRANSPOSE_MEMORY_ERROR; | |||
| goto exit_level_1; | |||
| } | |||
| z_t = (float*)LAPACKE_malloc( sizeof(float) * ldz_t * MAX(1,n) ); | |||
| if( z_t == NULL ) { | |||
| info = LAPACK_TRANSPOSE_MEMORY_ERROR; | |||
| goto exit_level_2; | |||
| } | |||
| b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,n) ); | |||
| if( b_t == NULL ) { | |||
| info = LAPACK_TRANSPOSE_MEMORY_ERROR; | |||
| goto exit_level_3; | |||
| } | |||
| w_t = (float*)LAPACKE_malloc( sizeof(float) * ldw_t * MAX(1,n) ); | |||
| if( w_t == NULL ) { | |||
| info = LAPACK_TRANSPOSE_MEMORY_ERROR; | |||
| goto exit_level_4; | |||
| } | |||
| s_t = (float*)LAPACKE_malloc( sizeof(float) * lds_t * MAX(1,n) ); | |||
| if( s_t == NULL ) { | |||
| info = LAPACK_TRANSPOSE_MEMORY_ERROR; | |||
| goto exit_level_5; | |||
| } | |||
| /* 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( s_t ); | |||
| exit_level_5: | |||
| LAPACKE_free( w_t ); | |||
| exit_level_4: | |||
| LAPACKE_free( b_t ); | |||
| exit_level_3: | |||
| LAPACKE_free( z_t ); | |||
| exit_level_2: | |||
| LAPACKE_free( y_t ); | |||
| exit_level_1: | |||
| LAPACKE_free( x_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; | |||
| } | |||
| @@ -0,0 +1,119 @@ | |||
| /***************************************************************************** | |||
| Copyright (c) 2014, Intel Corp. | |||
| All rights reserved. | |||
| Redistribution and use in source and binary forms, with or without | |||
| modification, are permitted provided that the following conditions are met: | |||
| * Redistributions of source code must retain the above copyright notice, | |||
| this list of conditions and the following disclaimer. | |||
| * Redistributions in binary form must reproduce the above copyright | |||
| notice, this list of conditions and the following disclaimer in the | |||
| documentation and/or other materials provided with the distribution. | |||
| * Neither the name of Intel Corporation nor the names of its contributors | |||
| may be used to endorse or promote products derived from this software | |||
| without specific prior written permission. | |||
| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" | |||
| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE | |||
| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE | |||
| ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE | |||
| LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR | |||
| CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF | |||
| SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS | |||
| INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN | |||
| CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) | |||
| ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF | |||
| THE POSSIBILITY OF SUCH DAMAGE. | |||
| ***************************************************************************** | |||
| * Contents: Native high-level C interface to LAPACK function sgedmdq | |||
| * Author: Intel Corporation | |||
| *****************************************************************************/ | |||
| #include "lapacke_utils.h" | |||
| lapack_int LAPACKE_sgedmdq( int matrix_layout, char jobs, char jobz, char jobr, | |||
| char jobq, char jobt, char jobf, lapack_int whtsvd, | |||
| lapack_int m, lapack_int n, float* f, lapack_int ldf, | |||
| float* x, lapack_int ldx, float* y, lapack_int ldy, | |||
| lapack_int nrnk, float tol, lapack_int k, | |||
| float* reig, float* imeig, float* z, | |||
| lapack_int ldz, float* res, float* b, lapack_int ldb, | |||
| float* v, lapack_int ldv, float* s, lapack_int lds) | |||
| { | |||
| lapack_int info = 0; | |||
| lapack_int lwork = -1; | |||
| lapack_int liwork = -1; | |||
| float* work = NULL; | |||
| lapack_int* iwork = NULL; | |||
| float work_query; | |||
| lapack_int iwork_query; | |||
| if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { | |||
| LAPACKE_xerbla( "LAPACKE_sgedmdq", -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, f, ldf ) ) { | |||
| return -11; | |||
| } | |||
| if( LAPACKE_sge_nancheck( matrix_layout, m, n, x, ldx ) ) { | |||
| return -13; | |||
| } | |||
| if( LAPACKE_sge_nancheck( matrix_layout, m, n, y, ldy ) ) { | |||
| return -15; | |||
| } | |||
| if( LAPACKE_sge_nancheck( matrix_layout, m, n, z, ldz ) ) { | |||
| return -22; | |||
| } | |||
| if( LAPACKE_sge_nancheck( matrix_layout, m, n, b, ldb ) ) { | |||
| return -25; | |||
| } | |||
| if( LAPACKE_sge_nancheck( matrix_layout, m, n, v, ldv ) ) { | |||
| return -27; | |||
| } | |||
| if( LAPACKE_sge_nancheck( matrix_layout, m, n, s, lds ) ) { | |||
| return -29; | |||
| } | |||
| } | |||
| #endif | |||
| /* Query optimal working array(s) size */ | |||
| info = LAPACKE_sgedmdq_work( matrix_layout, jobs, jobz, jobr, jobq, jobt, | |||
| jobf, whtsvd, m, n, f, ldf, x, ldx, y, ldy, | |||
| nrnk, tol, k, reig, imeig, z, ldz, res, | |||
| b, ldb, v, ldv, s, lds, &work_query, lwork, | |||
| &iwork_query, liwork ); | |||
| if( info != 0 ) { | |||
| goto exit_level_0; | |||
| } | |||
| lwork = (lapack_int) work_query; | |||
| liwork = iwork_query; | |||
| /* Allocate memory for work arrays */ | |||
| work = (float*)LAPACKE_malloc( sizeof(float) * lwork ); | |||
| if( work == NULL ) { | |||
| info = LAPACK_WORK_MEMORY_ERROR; | |||
| goto exit_level_0; | |||
| } | |||
| iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork ); | |||
| if( iwork == NULL ) { | |||
| info = LAPACK_WORK_MEMORY_ERROR; | |||
| goto exit_level_1; | |||
| } | |||
| /* Call middle-level interface */ | |||
| info = LAPACKE_sgedmdq_work( matrix_layout, jobs, jobz, jobr, jobq, jobt, | |||
| jobf, whtsvd, m, n, f, ldf, x, ldx, y, ldy, | |||
| nrnk, tol, k, reig, imeig, z, ldz, res, | |||
| b, ldb, v, ldv, s, lds, work, lwork, iwork, | |||
| liwork ); | |||
| /* Release memory and exit */ | |||
| LAPACKE_free( iwork ); | |||
| exit_level_1: | |||
| LAPACKE_free( work ); | |||
| exit_level_0: | |||
| if( info == LAPACK_WORK_MEMORY_ERROR ) { | |||
| LAPACKE_xerbla( "LAPACKE_sgedmdq", info ); | |||
| } | |||
| return info; | |||
| } | |||
| @@ -0,0 +1,200 @@ | |||
| /***************************************************************************** | |||
| 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 sgedmdq | |||
| * Author: Intel Corporation | |||
| *****************************************************************************/ | |||
| #include "lapacke_utils.h" | |||
| lapack_int LAPACKE_sgedmdq_work( int matrix_layout, char jobs, char jobz, | |||
| char jobr, char jobq, char jobt, char jobf, | |||
| lapack_int whtsvd, lapack_int m, lapack_int n, | |||
| float* f, lapack_int ldf, float* x, | |||
| lapack_int ldx, float* y, lapack_int ldy, | |||
| lapack_int nrnk, float tol, lapack_int k, | |||
| float* reig, float* imeig, float* z, | |||
| lapack_int ldz, float* res, float* b, | |||
| lapack_int ldb, float* v, lapack_int ldv, | |||
| float* s, lapack_int lds, float* work, | |||
| lapack_int lwork, lapack_int* iwork, | |||
| lapack_int liwork ) | |||
| { | |||
| lapack_int info = 0; | |||
| if( matrix_layout == LAPACK_COL_MAJOR ) { | |||
| /* Call LAPACK function and adjust info */ | |||
| LAPACK_sgedmdq( &jobs, &jobz, &jobr, &jobq, &jobt, &jobf, &whtsvd, &m, | |||
| &n, f, &ldf, x, &ldx, y, &ldy, &nrnk, &tol, &k, reig, | |||
| imeig, z, &ldz, res, b, &ldb, v, &ldv, s, &lds, | |||
| work, &lwork, iwork, &liwork, &info ); | |||
| if( info < 0 ) { | |||
| info = info - 1; | |||
| } | |||
| } else if( matrix_layout == LAPACK_ROW_MAJOR ) { | |||
| lapack_int ldf_t = MAX(1,m); | |||
| 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 ldv_t = MAX(1,m); | |||
| lapack_int lds_t = MAX(1,m); | |||
| float* f_t = NULL; | |||
| float* x_t = NULL; | |||
| float* y_t = NULL; | |||
| float* z_t = NULL; | |||
| float* b_t = NULL; | |||
| float* v_t = NULL; | |||
| float* s_t = NULL; | |||
| /* Check leading dimension(s) */ | |||
| if( ldf < n ) { | |||
| info = -12; | |||
| LAPACKE_xerbla( "LAPACKE_sgedmdq_work", info ); | |||
| return info; | |||
| } | |||
| if( ldx < n ) { | |||
| info = -14; | |||
| LAPACKE_xerbla( "LAPACKE_sgedmdq_work", info ); | |||
| return info; | |||
| } | |||
| if( ldy < n ) { | |||
| info = -16; | |||
| LAPACKE_xerbla( "LAPACKE_sgedmdq_work", info ); | |||
| return info; | |||
| } | |||
| if( ldz < n ) { | |||
| info = -23; | |||
| LAPACKE_xerbla( "LAPACKE_sgedmdq_work", info ); | |||
| return info; | |||
| } | |||
| if( ldb < n ) { | |||
| info = -26; | |||
| LAPACKE_xerbla( "LAPACKE_sgedmdq_work", info ); | |||
| return info; | |||
| } | |||
| if( ldv < n ) { | |||
| info = -28; | |||
| LAPACKE_xerbla( "LAPACKE_sgedmdq_work", info ); | |||
| return info; | |||
| } | |||
| if( lds < n ) { | |||
| info = -30; | |||
| LAPACKE_xerbla( "LAPACKE_sgedmdq_work", info ); | |||
| return info; | |||
| } | |||
| /* Query optimal working array(s) size if requested */ | |||
| if( lwork == -1 || liwork == -1 ) { | |||
| LAPACK_sgedmdq( &jobs, &jobz, &jobr, &jobq, &jobt, &jobf, &whtsvd, &m, | |||
| &n, f, &ldf, x, &ldx, y, &ldy, &nrnk, &tol, &k, reig, | |||
| imeig, z, &ldz, res, b, &ldb, v, &ldv, s, &lds, | |||
| work, &lwork, iwork, &liwork, &info ); | |||
| return (info < 0) ? (info - 1) : info; | |||
| } | |||
| /* Allocate memory for temporary array(s) */ | |||
| f_t = (float*)LAPACKE_malloc( sizeof(float) * ldf_t * MAX(1,n) ); | |||
| if( f_t == NULL ) { | |||
| info = LAPACK_TRANSPOSE_MEMORY_ERROR; | |||
| goto exit_level_0; | |||
| } | |||
| x_t = (float*)LAPACKE_malloc( sizeof(float) * ldx_t * MAX(1,n) ); | |||
| if( x_t == NULL ) { | |||
| info = LAPACK_TRANSPOSE_MEMORY_ERROR; | |||
| goto exit_level_1; | |||
| } | |||
| y_t = (float*)LAPACKE_malloc( sizeof(float) * ldy_t * MAX(1,n) ); | |||
| if( y_t == NULL ) { | |||
| info = LAPACK_TRANSPOSE_MEMORY_ERROR; | |||
| goto exit_level_2; | |||
| } | |||
| z_t = (float*)LAPACKE_malloc( sizeof(float) * ldz_t * MAX(1,n) ); | |||
| if( z_t == NULL ) { | |||
| info = LAPACK_TRANSPOSE_MEMORY_ERROR; | |||
| goto exit_level_3; | |||
| } | |||
| b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,n) ); | |||
| if( b_t == NULL ) { | |||
| info = LAPACK_TRANSPOSE_MEMORY_ERROR; | |||
| goto exit_level_4; | |||
| } | |||
| v_t = (float*)LAPACKE_malloc( sizeof(float) * ldv_t * MAX(1,n) ); | |||
| if( v_t == NULL ) { | |||
| info = LAPACK_TRANSPOSE_MEMORY_ERROR; | |||
| goto exit_level_5; | |||
| } | |||
| s_t = (float*)LAPACKE_malloc( sizeof(float) * lds_t * MAX(1,n) ); | |||
| if( s_t == NULL ) { | |||
| info = LAPACK_TRANSPOSE_MEMORY_ERROR; | |||
| goto exit_level_6; | |||
| } | |||
| /* Transpose input matrices */ | |||
| LAPACKE_sge_trans( matrix_layout, m, n, f, ldf, f_t, ldf_t ); | |||
| 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, v, ldv, v_t, ldv_t ); | |||
| LAPACKE_sge_trans( matrix_layout, m, n, s, lds, s_t, lds_t ); | |||
| /* Call LAPACK function and adjust info */ | |||
| LAPACK_sgedmdq( &jobs, &jobz, &jobr, &jobq, &jobt, &jobf, &whtsvd, &m, | |||
| &n, f, &ldf, x, &ldx, y, &ldy, &nrnk, &tol, &k, reig, | |||
| imeig, z, &ldz, res, b, &ldb, v, &ldv, s, &lds, | |||
| work, &lwork, iwork, &liwork, &info ); | |||
| if( info < 0 ) { | |||
| info = info - 1; | |||
| } | |||
| /* Transpose output matrices */ | |||
| LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, f_t, ldf_t, f, ldf ); | |||
| 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, v_t, ldv_t, v, ldv ); | |||
| LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, s_t, lds_t, s, lds ); | |||
| /* Release memory and exit */ | |||
| LAPACKE_free( s_t ); | |||
| exit_level_6: | |||
| LAPACKE_free( v_t ); | |||
| exit_level_5: | |||
| LAPACKE_free( b_t ); | |||
| exit_level_4: | |||
| LAPACKE_free( z_t ); | |||
| exit_level_3: | |||
| LAPACKE_free( y_t ); | |||
| exit_level_2: | |||
| LAPACKE_free( x_t ); | |||
| exit_level_1: | |||
| LAPACKE_free( f_t ); | |||
| exit_level_0: | |||
| if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { | |||
| LAPACKE_xerbla( "LAPACKE_sgedmdq_work", info ); | |||
| } | |||
| } else { | |||
| info = -1; | |||
| LAPACKE_xerbla( "LAPACKE_sgedmdq_work", info ); | |||
| } | |||
| return info; | |||
| } | |||
| @@ -0,0 +1,116 @@ | |||
| /***************************************************************************** | |||
| 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_int* iwork = NULL; | |||
| lapack_complex_double work_query; | |||
| lapack_int 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 -8; | |||
| } | |||
| if( LAPACKE_zge_nancheck( matrix_layout, m, n, y, ldy ) ) { | |||
| return -10; | |||
| } | |||
| if( LAPACKE_zge_nancheck( matrix_layout, m, n, z, ldz ) ) { | |||
| return -15; | |||
| } | |||
| if( LAPACKE_zge_nancheck( matrix_layout, m, n, b, ldb ) ) { | |||
| return -18; | |||
| } | |||
| if( LAPACKE_zge_nancheck( matrix_layout, m, n, s, lds ) ) { | |||
| return -20; | |||
| } | |||
| if( LAPACKE_zge_nancheck( matrix_layout, m, n, w, ldw ) ) { | |||
| return -22; | |||
| } | |||
| } | |||
| #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_Z2INT( work_query ); | |||
| liwork = iwork_query; | |||
| /* Allocate memory for work arrays */ | |||
| work = (lapack_complex_double*)LAPACKE_malloc( sizeof(lapack_complex_double) * lwork ); | |||
| if( work == NULL ) { | |||
| info = LAPACK_WORK_MEMORY_ERROR; | |||
| goto exit_level_0; | |||
| } | |||
| iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork ); | |||
| if( iwork == NULL ) { | |||
| info = LAPACK_WORK_MEMORY_ERROR; | |||
| goto exit_level_1; | |||
| } | |||
| /* 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( iwork ); | |||
| exit_level_1: | |||
| LAPACKE_free( work ); | |||
| exit_level_0: | |||
| if( info == LAPACK_WORK_MEMORY_ERROR ) { | |||
| LAPACKE_xerbla( "LAPACKE_zgedmd", info ); | |||
| } | |||
| return info; | |||
| } | |||
| @@ -0,0 +1,182 @@ | |||
| /***************************************************************************** | |||
| 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_int* 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 = -9; | |||
| LAPACKE_xerbla( "LAPACKE_zgedmd_work", info ); | |||
| return info; | |||
| } | |||
| if( ldy < n ) { | |||
| info = -11; | |||
| LAPACKE_xerbla( "LAPACKE_zgedmd_work", info ); | |||
| return info; | |||
| } | |||
| if( ldz < n ) { | |||
| info = -16; | |||
| LAPACKE_xerbla( "LAPACKE_zgedmd_work", info ); | |||
| return info; | |||
| } | |||
| if( ldb < n ) { | |||
| info = -19; | |||
| LAPACKE_xerbla( "LAPACKE_zgedmd_work", info ); | |||
| return info; | |||
| } | |||
| if( ldw < n ) { | |||
| info = -21; | |||
| LAPACKE_xerbla( "LAPACKE_zgedmd_work", info ); | |||
| return info; | |||
| } | |||
| if( lds < n ) { | |||
| info = -23; | |||
| 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) ); | |||
| if( x_t == NULL ) { | |||
| info = LAPACK_TRANSPOSE_MEMORY_ERROR; | |||
| goto exit_level_0; | |||
| } | |||
| y_t = (lapack_complex_double*)LAPACKE_malloc( sizeof(lapack_complex_double) * ldy_t * MAX(1,n) ); | |||
| if( y_t == NULL ) { | |||
| info = LAPACK_TRANSPOSE_MEMORY_ERROR; | |||
| goto exit_level_1; | |||
| } | |||
| z_t = (lapack_complex_double*)LAPACKE_malloc( sizeof(lapack_complex_double) * ldz_t * MAX(1,n) ); | |||
| if( z_t == NULL ) { | |||
| info = LAPACK_TRANSPOSE_MEMORY_ERROR; | |||
| goto exit_level_2; | |||
| } | |||
| b_t = (lapack_complex_double*)LAPACKE_malloc( sizeof(lapack_complex_double) * ldb_t * MAX(1,n) ); | |||
| if( b_t == NULL ) { | |||
| info = LAPACK_TRANSPOSE_MEMORY_ERROR; | |||
| goto exit_level_3; | |||
| } | |||
| w_t = (lapack_complex_double*)LAPACKE_malloc( sizeof(lapack_complex_double) * ldw_t * MAX(1,n) ); | |||
| if( w_t == NULL ) { | |||
| info = LAPACK_TRANSPOSE_MEMORY_ERROR; | |||
| goto exit_level_4; | |||
| } | |||
| s_t = (lapack_complex_double*)LAPACKE_malloc( sizeof(lapack_complex_double) * lds_t * MAX(1,n) ); | |||
| if( s_t == NULL ) { | |||
| info = LAPACK_TRANSPOSE_MEMORY_ERROR; | |||
| goto exit_level_5; | |||
| } | |||
| /* 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( s_t ); | |||
| exit_level_5: | |||
| LAPACKE_free( w_t ); | |||
| exit_level_4: | |||
| LAPACKE_free( b_t ); | |||
| exit_level_3: | |||
| LAPACKE_free( z_t ); | |||
| exit_level_2: | |||
| LAPACKE_free( y_t ); | |||
| exit_level_1: | |||
| LAPACKE_free( x_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; | |||
| } | |||
| @@ -0,0 +1,123 @@ | |||
| /***************************************************************************** | |||
| 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 zgedmdq | |||
| * Author: Intel Corporation | |||
| *****************************************************************************/ | |||
| #include "lapacke_utils.h" | |||
| lapack_int LAPACKE_zgedmdq( int matrix_layout, char jobs, char jobz, char jobr, | |||
| char jobq, char jobt, char jobf, lapack_int whtsvd, | |||
| lapack_int m, lapack_int n, lapack_complex_double* f, | |||
| lapack_int ldf, lapack_complex_double* x, | |||
| lapack_int ldx, lapack_complex_double* y, | |||
| lapack_int ldy, lapack_int nrnk, double tol, | |||
| 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* v, | |||
| lapack_int ldv, 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_int* iwork = NULL; | |||
| lapack_complex_double work_query; | |||
| lapack_int iwork_query; | |||
| if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { | |||
| LAPACKE_xerbla( "LAPACKE_cgedmdq", -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, f, ldf ) ) { | |||
| return -11; | |||
| } | |||
| if( LAPACKE_zge_nancheck( matrix_layout, m, n, x, ldx ) ) { | |||
| return -13; | |||
| } | |||
| if( LAPACKE_zge_nancheck( matrix_layout, m, n, y, ldy ) ) { | |||
| return -15; | |||
| } | |||
| if( LAPACKE_zge_nancheck( matrix_layout, m, n, z, ldz ) ) { | |||
| return -22; | |||
| } | |||
| if( LAPACKE_zge_nancheck( matrix_layout, m, n, b, ldb ) ) { | |||
| return -25; | |||
| } | |||
| if( LAPACKE_zge_nancheck( matrix_layout, m, n, v, ldv ) ) { | |||
| return -27; | |||
| } | |||
| if( LAPACKE_zge_nancheck( matrix_layout, m, n, s, lds ) ) { | |||
| return -29; | |||
| } | |||
| } | |||
| #endif | |||
| /* Query optimal working array(s) size */ | |||
| info = LAPACKE_zgedmdq_work( matrix_layout, jobs, jobz, jobr, jobq, jobt, | |||
| jobf, whtsvd, m, n, f, ldf, x, ldx, y, ldy, | |||
| nrnk, tol, k, reig, imeig, z, ldz, res, | |||
| b, ldb, v, ldv, s, lds, &work_query, lwork, | |||
| &iwork_query, liwork ); | |||
| if( info != 0 ) { | |||
| goto exit_level_0; | |||
| } | |||
| lwork = LAPACK_Z2INT( work_query ); | |||
| liwork = iwork_query; | |||
| /* Allocate memory for work arrays */ | |||
| work = (lapack_complex_double*)LAPACKE_malloc( sizeof(lapack_complex_double) * lwork ); | |||
| if( work == NULL ) { | |||
| info = LAPACK_WORK_MEMORY_ERROR; | |||
| goto exit_level_0; | |||
| } | |||
| iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork ); | |||
| if( iwork == NULL ) { | |||
| info = LAPACK_WORK_MEMORY_ERROR; | |||
| goto exit_level_1; | |||
| } | |||
| /* Call middle-level interface */ | |||
| info = LAPACKE_zgedmdq_work( matrix_layout, jobs, jobz, jobr, jobq, jobt, | |||
| jobf, whtsvd, m, n, f, ldf, x, ldx, y, ldy, | |||
| nrnk, tol, k, reig, imeig, z, ldz, res, | |||
| b, ldb, v, ldv, s, lds, work, lwork, iwork, | |||
| liwork ); | |||
| /* Release memory and exit */ | |||
| LAPACKE_free( iwork ); | |||
| exit_level_1: | |||
| LAPACKE_free( work ); | |||
| exit_level_0: | |||
| if( info == LAPACK_WORK_MEMORY_ERROR ) { | |||
| LAPACKE_xerbla( "LAPACKE_zgedmdq", info ); | |||
| } | |||
| return info; | |||
| } | |||
| @@ -0,0 +1,205 @@ | |||
| /***************************************************************************** | |||
| 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 zgedmdq | |||
| * Author: Intel Corporation | |||
| *****************************************************************************/ | |||
| #include "lapacke_utils.h" | |||
| lapack_int LAPACKE_zgedmdq_work( int matrix_layout, char jobs, char jobz, | |||
| char jobr, char jobq, char jobt, char jobf, | |||
| lapack_int whtsvd, lapack_int m, lapack_int n, | |||
| lapack_complex_double* f, lapack_int ldf, | |||
| lapack_complex_double* x, lapack_int ldx, | |||
| lapack_complex_double* y, lapack_int ldy, | |||
| lapack_int nrnk, double tol, 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* v, | |||
| lapack_int ldv, lapack_complex_double* s, | |||
| lapack_int lds, lapack_complex_double* work, | |||
| lapack_int lwork, lapack_int* iwork, | |||
| lapack_int liwork ) | |||
| { | |||
| lapack_int info = 0; | |||
| if( matrix_layout == LAPACK_COL_MAJOR ) { | |||
| /* Call LAPACK function and adjust info */ | |||
| LAPACK_zgedmdq( &jobs, &jobz, &jobr, &jobq, &jobt, &jobf, &whtsvd, &m, | |||
| &n, f, &ldf, x, &ldx, y, &ldy, &nrnk, &tol, &k, reig, | |||
| imeig, z, &ldz, res, b, &ldb, v, &ldv, s, &lds, | |||
| work, &lwork, iwork, &liwork, &info ); | |||
| if( info < 0 ) { | |||
| info = info - 1; | |||
| } | |||
| } else if( matrix_layout == LAPACK_ROW_MAJOR ) { | |||
| lapack_int ldf_t = MAX(1,m); | |||
| 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 ldv_t = MAX(1,m); | |||
| lapack_int lds_t = MAX(1,m); | |||
| lapack_complex_double* f_t = NULL; | |||
| 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* v_t = NULL; | |||
| lapack_complex_double* s_t = NULL; | |||
| /* Check leading dimension(s) */ | |||
| if( ldf < n ) { | |||
| info = -12; | |||
| LAPACKE_xerbla( "LAPACKE_zgedmdq_work", info ); | |||
| return info; | |||
| } | |||
| if( ldx < n ) { | |||
| info = -14; | |||
| LAPACKE_xerbla( "LAPACKE_zgedmdq_work", info ); | |||
| return info; | |||
| } | |||
| if( ldy < n ) { | |||
| info = -16; | |||
| LAPACKE_xerbla( "LAPACKE_zgedmdq_work", info ); | |||
| return info; | |||
| } | |||
| if( ldz < n ) { | |||
| info = -23; | |||
| LAPACKE_xerbla( "LAPACKE_zgedmdq_work", info ); | |||
| return info; | |||
| } | |||
| if( ldb < n ) { | |||
| info = -26; | |||
| LAPACKE_xerbla( "LAPACKE_zgedmdq_work", info ); | |||
| return info; | |||
| } | |||
| if( ldv < n ) { | |||
| info = -28; | |||
| LAPACKE_xerbla( "LAPACKE_zgedmdq_work", info ); | |||
| return info; | |||
| } | |||
| if( lds < n ) { | |||
| info = -30; | |||
| LAPACKE_xerbla( "LAPACKE_zgedmdq_work", info ); | |||
| return info; | |||
| } | |||
| /* Query optimal working array(s) size if requested */ | |||
| if( lwork == -1 || liwork == -1 ) { | |||
| LAPACK_zgedmdq( &jobs, &jobz, &jobr, &jobq, &jobt, &jobf, &whtsvd, &m, | |||
| &n, f, &ldf, x, &ldx, y, &ldy, &nrnk, &tol, &k, reig, | |||
| imeig, z, &ldz, res, b, &ldb, v, &ldv, s, &lds, | |||
| work, &lwork, iwork, &liwork, &info ); | |||
| return (info < 0) ? (info - 1) : info; | |||
| } | |||
| /* Allocate memory for temporary array(s) */ | |||
| f_t = (lapack_complex_double*)LAPACKE_malloc( sizeof(lapack_complex_double) * ldf_t * MAX(1,n) ); | |||
| if( f_t == NULL ) { | |||
| info = LAPACK_TRANSPOSE_MEMORY_ERROR; | |||
| goto exit_level_0; | |||
| } | |||
| x_t = (lapack_complex_double*)LAPACKE_malloc( sizeof(lapack_complex_double) * ldx_t * MAX(1,n) ); | |||
| if( x_t == NULL ) { | |||
| info = LAPACK_TRANSPOSE_MEMORY_ERROR; | |||
| goto exit_level_1; | |||
| } | |||
| y_t = (lapack_complex_double*)LAPACKE_malloc( sizeof(lapack_complex_double) * ldy_t * MAX(1,n) ); | |||
| if( y_t == NULL ) { | |||
| info = LAPACK_TRANSPOSE_MEMORY_ERROR; | |||
| goto exit_level_2; | |||
| } | |||
| z_t = (lapack_complex_double*)LAPACKE_malloc( sizeof(lapack_complex_double) * ldz_t * MAX(1,n) ); | |||
| if( z_t == NULL ) { | |||
| info = LAPACK_TRANSPOSE_MEMORY_ERROR; | |||
| goto exit_level_3; | |||
| } | |||
| b_t = (lapack_complex_double*)LAPACKE_malloc( sizeof(lapack_complex_double) * ldb_t * MAX(1,n) ); | |||
| if( b_t == NULL ) { | |||
| info = LAPACK_TRANSPOSE_MEMORY_ERROR; | |||
| goto exit_level_4; | |||
| } | |||
| v_t = (lapack_complex_double*)LAPACKE_malloc( sizeof(lapack_complex_double) * ldv_t * MAX(1,n) ); | |||
| if( v_t == NULL ) { | |||
| info = LAPACK_TRANSPOSE_MEMORY_ERROR; | |||
| goto exit_level_5; | |||
| } | |||
| s_t = (lapack_complex_double*)LAPACKE_malloc( sizeof(lapack_complex_double) * lds_t * MAX(1,n) ); | |||
| if( s_t == NULL ) { | |||
| info = LAPACK_TRANSPOSE_MEMORY_ERROR; | |||
| goto exit_level_6; | |||
| } | |||
| /* Transpose input matrices */ | |||
| LAPACKE_zge_trans( matrix_layout, m, n, f, ldf, f_t, ldf_t ); | |||
| 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, v, ldv, v_t, ldv_t ); | |||
| LAPACKE_zge_trans( matrix_layout, m, n, s, lds, s_t, lds_t ); | |||
| /* Call LAPACK function and adjust info */ | |||
| LAPACK_zgedmdq( &jobs, &jobz, &jobr, &jobq, &jobt, &jobf, &whtsvd, &m, | |||
| &n, f, &ldf, x, &ldx, y, &ldy, &nrnk, &tol, &k, reig, | |||
| imeig, z, &ldz, res, b, &ldb, v, &ldv, s, &lds, | |||
| work, &lwork, iwork, &liwork, &info ); | |||
| if( info < 0 ) { | |||
| info = info - 1; | |||
| } | |||
| /* Transpose output matrices */ | |||
| LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, f_t, ldf_t, f, ldf ); | |||
| 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, v_t, ldv_t, v, ldv ); | |||
| LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, s_t, lds_t, s, lds ); | |||
| /* Release memory and exit */ | |||
| LAPACKE_free( s_t ); | |||
| exit_level_6: | |||
| LAPACKE_free( v_t ); | |||
| exit_level_5: | |||
| LAPACKE_free( b_t ); | |||
| exit_level_4: | |||
| LAPACKE_free( z_t ); | |||
| exit_level_3: | |||
| LAPACKE_free( y_t ); | |||
| exit_level_2: | |||
| LAPACKE_free( x_t ); | |||
| exit_level_1: | |||
| LAPACKE_free( f_t ); | |||
| exit_level_0: | |||
| if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { | |||
| LAPACKE_xerbla( "LAPACKE_zgedmdq_work", info ); | |||
| } | |||
| } else { | |||
| info = -1; | |||
| LAPACKE_xerbla( "LAPACKE_zgedmdq_work", info ); | |||
| } | |||
| return info; | |||
| } | |||