From 0f68da835c19a0b861c89836aead5d6aba5de92f Mon Sep 17 00:00:00 2001 From: moluopro Date: Mon, 13 Jul 2026 12:40:03 +0800 Subject: [PATCH] Remove misplaced LAPACKE GESVDQ wrapper sources These stale duplicate sources are not referenced by the build. The canonical implementations remain under lapack-netlib/LAPACKE/src. Signed-off-by: moluopro --- lapack-netlib/SRC/lapacke_cgesvdq_work.c | 165 ----------------------- lapack-netlib/SRC/lapacke_dgesvdq_work.c | 165 ----------------------- lapack-netlib/SRC/lapacke_sgesvdq_work.c | 165 ----------------------- lapack-netlib/SRC/lapacke_zgesvdq_work.c | 165 ----------------------- 4 files changed, 660 deletions(-) delete mode 100644 lapack-netlib/SRC/lapacke_cgesvdq_work.c delete mode 100644 lapack-netlib/SRC/lapacke_dgesvdq_work.c delete mode 100644 lapack-netlib/SRC/lapacke_sgesvdq_work.c delete mode 100644 lapack-netlib/SRC/lapacke_zgesvdq_work.c diff --git a/lapack-netlib/SRC/lapacke_cgesvdq_work.c b/lapack-netlib/SRC/lapacke_cgesvdq_work.c deleted file mode 100644 index 6601c8a24..000000000 --- a/lapack-netlib/SRC/lapacke_cgesvdq_work.c +++ /dev/null @@ -1,165 +0,0 @@ -/***************************************************************************** - 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 cgesvdq -* Author: Intel Corporation -*****************************************************************************/ - -#include "lapacke_utils.h" - -lapack_int LAPACKE_cgesvdq_work( int matrix_layout, char joba, char jobp, - char jobr, char jobu, char jobv, - lapack_int m, lapack_int n, lapack_complex_float* a, - lapack_int lda, float* s, lapack_complex_float* u, lapack_int ldu, - lapack_complex_float* v, lapack_int ldv, lapack_int* numrank, - lapack_int* iwork, lapack_int liwork, - lapack_complex_float* cwork, lapack_int lcwork, - float* rwork, lapack_int lrwork ) -{ - lapack_int info = 0; - if( matrix_layout == LAPACK_COL_MAJOR ) { - /* Call LAPACK function and adjust info */ - LAPACK_cgesvdq( &joba, &jobp, &jobr, &jobu, &jobv, &m, &n, a, &lda, s, u, &ldu, v, &ldv, - numrank, iwork, &liwork, cwork, &lcwork, rwork, &lrwork, &info ); - if( info < 0 ) { - info = info - 1; - } - } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - lapack_int nrows_u = LAPACKE_lsame( jobu, 'a' ) || - LAPACKE_lsame( jobu, 'u' ) || - LAPACKE_lsame( jobu, 'r' ) || - LAPACKE_lsame( jobu, 'f' ) || - LAPACKE_lsame( jobu, 's' ) ? m : 1; - lapack_int ncols_u = LAPACKE_lsame( jobu, 'a' ) ? m : - ( LAPACKE_lsame( jobu, 's' ) || - (LAPACKE_lsame( jobu, 'u' ) ) ? MIN(m,n) : 1); - lapack_int nrows_v = ( LAPACKE_lsame( jobv, 'a' ) || - LAPACKE_lsame( jobv, 'v' ) || - LAPACKE_lsame( jobv, 'r' )) ? n : 1; - lapack_int lda_t = MAX(1,m); - lapack_int ldu_t = MAX(1,nrows_u); - lapack_int ldv_t = MAX(1,nrows_v); - lapack_complex_float* a_t = NULL; - lapack_complex_float* u_t = NULL; - lapack_complex_float* v_t = NULL; - /* Check leading dimension(s) */ - if( lda < n ) { - info = -9; - LAPACKE_xerbla( "LAPACKE_cgesvdq_work", info ); - return info; - } - if( ldu < ncols_u ) { - info = -12; - LAPACKE_xerbla( "LAPACKE_cgesvdq_work", info ); - return info; - } - if( ldv < n ) { - info = -14; - LAPACKE_xerbla( "LAPACKE_cgesvdq_work", info ); - return info; - } - /* Query optimal working array(s) size if requested */ - if( lcwork == -1 ) { - LAPACK_cgesvdq( &joba, &jobp, &jobr, &jobu, &jobv, &m, &n, a, &lda_t, - s, u, &ldu_t, v, &ldv_t, numrank, iwork, &liwork, - cwork, &lcwork, rwork, &lrwork, &info ); - return (info < 0) ? (info - 1) : info; - } - /* Allocate memory for temporary array(s) */ - a_t = (lapack_complex_float*)LAPACKE_malloc( sizeof(lapack_complex_float) * lda_t * MAX(1,n) ); - if( a_t == NULL ) { - info = LAPACK_TRANSPOSE_MEMORY_ERROR; - goto exit_level_0; - } - if( LAPACKE_lsame( jobu, 'a' ) || LAPACKE_lsame( jobu, 's' ) || - LAPACKE_lsame( jobu, 'u' ) || - LAPACKE_lsame( jobu, 'r' ) || - LAPACKE_lsame( jobu, 'f' ) ) { - u_t = (lapack_complex_float*) - LAPACKE_malloc( sizeof(lapack_complex_float) * ldu_t * MAX(1,ncols_u) ); - if( u_t == NULL ) { - info = LAPACK_TRANSPOSE_MEMORY_ERROR; - goto exit_level_1; - } - } - if( LAPACKE_lsame( jobv, 'a' ) || LAPACKE_lsame( jobv, 'v' ) || - LAPACKE_lsame( jobv, 'r' ) ) { - 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_2; - } - } - /* Transpose input matrices */ - LAPACKE_cge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); - /* Call LAPACK function and adjust info */ - LAPACK_cgesvdq( &joba, &jobp, &jobr, &jobu, &jobv, &m, &n, a, &lda_t, - s, u, &ldu_t, v, &ldv_t, numrank, iwork, &liwork, - cwork, &lcwork, rwork, &lrwork, &info ); - if( info < 0 ) { - info = info - 1; - } - /* Transpose output matrices */ - LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); - if( LAPACKE_lsame( jobu, 'a' ) ||LAPACKE_lsame( jobu, 's' ) || - LAPACKE_lsame( jobu, 'u' ) || - LAPACKE_lsame( jobu, 'r' ) || - LAPACKE_lsame( jobu, 'f' ) ) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, nrows_u, ncols_u, u_t, ldu_t, - u, ldu ); - } - if( LAPACKE_lsame( jobv, 'a' ) || LAPACKE_lsame( jobv, 'v' ) || - LAPACKE_lsame( jobv, 'r' )) { - LAPACKE_cge_trans( LAPACK_COL_MAJOR, nrows_v, n, v_t, ldv_t, v, - ldv ); - } - /* Release memory and exit */ - if( LAPACKE_lsame( jobv, 'a' ) || LAPACKE_lsame( jobv, 'v' ) || - LAPACKE_lsame( jobv, 'r' ) ) { - LAPACKE_free( v_t ); - } -exit_level_2: - if( LAPACKE_lsame( jobu, 'a' ) || LAPACKE_lsame( jobu, 's' ) || - LAPACKE_lsame( jobu, 'u' ) || - LAPACKE_lsame( jobu, 'r' ) || - LAPACKE_lsame( jobu, 'f' ) ) { - LAPACKE_free( u_t ); - } -exit_level_1: - LAPACKE_free( a_t ); -exit_level_0: - if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_cgesvdq_work", info ); - } - } else { - info = -1; - LAPACKE_xerbla( "LAPACKE_cgesvdq_work", info ); - } - return info; -} diff --git a/lapack-netlib/SRC/lapacke_dgesvdq_work.c b/lapack-netlib/SRC/lapacke_dgesvdq_work.c deleted file mode 100644 index 3a3e76450..000000000 --- a/lapack-netlib/SRC/lapacke_dgesvdq_work.c +++ /dev/null @@ -1,165 +0,0 @@ -/***************************************************************************** - 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 dgesvdq -* Author: Intel Corporation -*****************************************************************************/ - -#include "lapacke_utils.h" - -lapack_int LAPACKE_dgesvdq_work( int matrix_layout, char joba, char jobp, - char jobr, char jobu, char jobv, - lapack_int m, lapack_int n, double* a, - lapack_int lda, double* s, double* u, lapack_int ldu, - double* v, lapack_int ldv, lapack_int* numrank, - lapack_int* iwork, lapack_int liwork, - double* work, lapack_int lwork, - double* rwork, lapack_int lrwork ) -{ - lapack_int info = 0; - if( matrix_layout == LAPACK_COL_MAJOR ) { - /* Call LAPACK function and adjust info */ - LAPACK_dgesvdq( &joba, &jobp, &jobr, &jobu, &jobv, &m, &n, a, &lda, s, u, &ldu, v, &ldv, - numrank, iwork, &liwork, work, &lwork, rwork, &lrwork, &info ); - if( info < 0 ) { - info = info - 1; - } - } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - lapack_int nrows_u = ( LAPACKE_lsame( jobu, 'a' ) || - LAPACKE_lsame( jobu, 'u' ) || - LAPACKE_lsame( jobu, 'r' ) || - LAPACKE_lsame( jobu, 'f' ) || - LAPACKE_lsame( jobu, 's' ) ) ? m : 1; - lapack_int ncols_u = LAPACKE_lsame( jobu, 'a' ) ? m : - ( (LAPACKE_lsame( jobu, 's' ) || - LAPACKE_lsame( jobu, 'u' ) ) ? MIN(m,n) : 1); - lapack_int nrows_v = ( LAPACKE_lsame( jobv, 'a' ) || - LAPACKE_lsame( jobu, 'v' ) || - LAPACKE_lsame( jobu, 'r' )) ? n : 1; - lapack_int lda_t = MAX(1,m); - lapack_int ldu_t = MAX(1,nrows_u); - lapack_int ldv_t = MAX(1,nrows_v); - double* a_t = NULL; - double* u_t = NULL; - double* v_t = NULL; - /* Check leading dimension(s) */ - if( lda < n ) { - info = -9; - LAPACKE_xerbla( "LAPACKE_dgesvdq_work", info ); - return info; - } - if( ldu < ncols_u ) { - info = -12; - LAPACKE_xerbla( "LAPACKE_dgesvdq_work", info ); - return info; - } - if( ldv < n ) { - info = -14; - LAPACKE_xerbla( "LAPACKE_dgesvdq_work", info ); - return info; - } - /* Query optimal working array(s) size if requested */ - if( lwork == -1 ) { - LAPACK_dgesvdq( &joba, &jobp, &jobr, &jobu, &jobv, &m, &n, a, &lda_t, - s, u, &ldu_t, v, &ldv_t, numrank, iwork, &liwork, - work, &lwork, rwork, &lrwork, &info ); - return (info < 0) ? (info - 1) : info; - } - /* Allocate memory for temporary array(s) */ - a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) ); - if( a_t == NULL ) { - info = LAPACK_TRANSPOSE_MEMORY_ERROR; - goto exit_level_0; - } - if( LAPACKE_lsame( jobu, 'a' ) || LAPACKE_lsame( jobu, 's' ) || - LAPACKE_lsame( jobu, 'u' ) || - LAPACKE_lsame( jobu, 'r' ) || - LAPACKE_lsame( jobu, 'f' ) ) { - u_t = (double*) - LAPACKE_malloc( sizeof(double) * ldu_t * MAX(1,ncols_u) ); - if( u_t == NULL ) { - info = LAPACK_TRANSPOSE_MEMORY_ERROR; - goto exit_level_1; - } - } - if( LAPACKE_lsame( jobv, 'a' ) || LAPACKE_lsame( jobv, 'v' ) || - LAPACKE_lsame( jobu, 'r' ) ) { - v_t = (double*) - LAPACKE_malloc( sizeof(double) * ldv_t * MAX(1,n) ); - if( v_t == NULL ) { - info = LAPACK_TRANSPOSE_MEMORY_ERROR; - goto exit_level_2; - } - } - /* Transpose input matrices */ - LAPACKE_dge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); - /* Call LAPACK function and adjust info */ - LAPACK_dgesvdq( &joba, &jobp, &jobr, &jobu, &jobv, &m, &n, a, &lda_t, - s, u, &ldu_t, v, &ldv_t, numrank, iwork, &liwork, - work, &lwork, rwork, &lrwork, &info ); - if( info < 0 ) { - info = info - 1; - } - /* Transpose output matrices */ - LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); - if( LAPACKE_lsame( jobu, 'a' ) || LAPACKE_lsame( jobu, 's' ) || - LAPACKE_lsame( jobu, 'u' ) || - LAPACKE_lsame( jobu, 'r' ) || - LAPACKE_lsame( jobu, 'f' ) ) { - LAPACKE_dge_trans)( LAPACK_COL_MAJOR, nrows_u, ncols_u, u_t, ldu_t, - u, ldu ); - } - if( LAPACKE_lsame( jobv, 'a' ) || LAPACKE_lsame( jobv, 'v' ) || - LAPACKE_lsame( jobu, 'r' )) { - LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrows_v, n, v_t, ldv_t, v, - ldv ); - } - /* Release memory and exit */ - if( LAPACKE_lsame( jobv, 'a' ) || LAPACKE_lsame( jobv, 'v' ) || - LAPACKE_lsame( jobu, 'r' ) ) { - LAPACKE_free( v_t ); - } -exit_level_2: - if( LAPACKE_lsame( jobu, 'a' ) || LAPACKE_lsame( jobu, 's' ) || - LAPACKE_lsame( jobu, 'u' ) || - LAPACKE_lsame( jobu, 'r' ) || - LAPACKE_lsame( jobu, 'f' ) ) { - LAPACKE_free( u_t ); - } -exit_level_1: - LAPACKE_free( a_t ); -exit_level_0: - if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_dgesvdq_work", info ); - } - } else { - info = -1; - LAPACKE_xerbla( "LAPACKE_dgesvdq_work", info ); - } - return info; -} diff --git a/lapack-netlib/SRC/lapacke_sgesvdq_work.c b/lapack-netlib/SRC/lapacke_sgesvdq_work.c deleted file mode 100644 index f786d75f7..000000000 --- a/lapack-netlib/SRC/lapacke_sgesvdq_work.c +++ /dev/null @@ -1,165 +0,0 @@ -/***************************************************************************** - 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 sgesvdq -* Author: Intel Corporation -*****************************************************************************/ - -#include "lapacke_utils.h" - -lapack_int LAPACKE_sgesvdq_work( int matrix_layout, char joba, char jobp, - char jobr, char jobu, char jobv, - lapack_int m, lapack_int n, float* a, - lapack_int lda, float* s, float* u, lapack_int ldu, - float* v, lapack_int ldv, lapack_int* numrank, - lapack_int* iwork, lapack_int liwork, - float* work, lapack_int lwork, - float* rwork, lapack_int lrwork ) -{ - lapack_int info = 0; - if( matrix_layout == LAPACK_COL_MAJOR ) { - /* Call LAPACK function and adjust info */ - LAPACK_sgesvdq( &joba, &jobp, &jobr, &jobu, &jobv, &m, &n, a, &lda, s, u, &ldu, v, &ldv, - numrank, iwork, &liwork, work, &lwork, rwork, &lrwork, &info ); - if( info < 0 ) { - info = info - 1; - } - } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - lapack_int nrows_u = ( LAPACKE_lsame( jobu, 'a' ) || - LAPACKE_lsame( jobu, 'u' ) || - LAPACKE_lsame( jobu, 'r' ) || - LAPACKE_lsame( jobu, 'f' ) || - LAPACKE_lsame( jobu, 's' ) ) ? m : 1; - lapack_int ncols_u = LAPACKE_lsame( jobu, 'a' ) ? m : - ( (LAPACKE_lsame( jobu, 's' ) || - LAPACKE_lsame( jobu, 'u' ) ) ? MIN(m,n) : 1); - lapack_int nrows_v = ( LAPACKE_lsame( jobv, 'a' ) || - LAPACKE_lsame( jobv, 'v' ) || - LAPACKE_lsame( jobv, 'r' )) ? n : 1; - lapack_int lda_t = MAX(1,m); - lapack_int ldu_t = MAX(1,nrows_u); - lapack_int ldv_t = MAX(1,nrows_v); - float* a_t = NULL; - float* u_t = NULL; - float* v_t = NULL; - /* Check leading dimension(s) */ - if( lda < n ) { - info = -9; - LAPACKE_xerbla( "LAPACKE_sgesvdq_work", info ); - return info; - } - if( ldu < ncols_u ) { - info = -12; - LAPACKE_xerbla( "LAPACKE_sgesvdq_work", info ); - return info; - } - if( ldv < n ) { - info = -14; - LAPACKE_xerbla( "LAPACKE_sgesvdq_work", info ); - return info; - } - /* Query optimal working array(s) size if requested */ - if( lwork == -1 ) { - LAPACK_sgesvdq( &joba, &jobp, &jobr, &jobu, &jobv, &m, &n, a, &lda_t, - s, u, &ldu_t, v, &ldv_t, numrank, iwork, &liwork, - work, &lwork, rwork, &lrwork, &info ); - return (info < 0) ? (info - 1) : info; - } - /* Allocate memory for temporary array(s) */ - a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) ); - if( a_t == NULL ) { - info = LAPACK_TRANSPOSE_MEMORY_ERROR; - goto exit_level_0; - } - if( LAPACKE_lsame( jobu, 'a' ) || LAPACKE_lsame( jobu, 's' ) || - LAPACKE_lsame( jobu, 'u' ) || - LAPACKE_lsame( jobu, 'r' ) || - LAPACKE_lsame( jobu, 'f' ) ) { - u_t = (float*) - LAPACKE_malloc( sizeof(float) * ldu_t * MAX(1,ncols_u) ); - if( u_t == NULL ) { - info = LAPACK_TRANSPOSE_MEMORY_ERROR; - goto exit_level_1; - } - } - if( LAPACKE_lsame( jobv, 'a' ) || LAPACKE_lsame( jobv, 'v' ) || - LAPACKE_lsame( jobv, 'r' ) ) { - v_t = (float*) - LAPACKE_malloc( sizeof(float) * ldv_t * MAX(1,n) ); - if( v_t == NULL ) { - info = LAPACK_TRANSPOSE_MEMORY_ERROR; - goto exit_level_2; - } - } - /* Transpose input matrices */ - LAPACKE_sge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); - /* Call LAPACK function and adjust info */ - LAPACK_sgesvdq( &joba, &jobp, &jobr, &jobu, &jobv, &m, &n, a, &lda_t, - s, u, &ldu_t, v, &ldv_t, numrank, iwork, &liwork, - work, &lwork, rwork, &lrwork, &info ); - if( info < 0 ) { - info = info - 1; - } - /* Transpose output matrices */ - LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); - if( LAPACKE_lsame( jobu, 'a' ) || LAPACKE_lsame( jobu, 's' ) || - LAPACKE_lsame( jobu, 'u' ) || - LAPACKE_lsame( jobu, 'r' ) || - LAPACKE_lsame( jobu, 'f' ) ) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_u, ncols_u, u_t, ldu_t, - u, ldu ); - } - if( LAPACKE_lsame( jobv, 'a' ) || LAPACKE_lsame( jobv, 'v' ) || - LAPACKE_lsame( jobv, 'r' )) { - LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_v, n, v_t, ldv_t, v, - ldv ); - } - /* Release memory and exit */ - if( LAPACKE_lsame( jobv, 'a' ) || LAPACKE_lsame( jobv, 'v' ) || - LAPACKE_lsame( jobv, 'r' ) ) { - LAPACKE_free( v_t ); - } -exit_level_2: - if( LAPACKE_lsame( jobu, 'a' ) || LAPACKE_lsame( jobu, 's' ) || - LAPACKE_lsame( jobu, 'u' ) || - LAPACKE_lsame( jobu, 'r' ) || - LAPACKE_lsame( jobu, 'f' ) ) { - LAPACKE_free( u_t ); - } -exit_level_1: - LAPACKE_free( a_t ); -exit_level_0: - if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_sgesvdq_work", info ); - } - } else { - info = -1; - LAPACKE_xerbla( "LAPACKE_sgesvdq_work", info ); - } - return info; -} diff --git a/lapack-netlib/SRC/lapacke_zgesvdq_work.c b/lapack-netlib/SRC/lapacke_zgesvdq_work.c deleted file mode 100644 index 32f6c0296..000000000 --- a/lapack-netlib/SRC/lapacke_zgesvdq_work.c +++ /dev/null @@ -1,165 +0,0 @@ -/***************************************************************************** - 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 zgesvdq -* Author: Intel Corporation -*****************************************************************************/ - -#include "lapacke_utils.h" - -lapack_int LAPACKE_zgesvdq_work( int matrix_layout, char joba, char jobp, - char jobr, char jobu, char jobv, - lapack_int m, lapack_int n, lapack_complex_double* a, - lapack_int lda, double* s, lapack_complex_double* u, lapack_int ldu, - lapack_complex_double* v, lapack_int ldv, lapack_int* numrank, - lapack_int* iwork, lapack_int liwork, - lapack_complex_double* cwork, lapack_int lcwork, - double* rwork, lapack_int lrwork ) -{ - lapack_int info = 0; - if( matrix_layout == LAPACK_COL_MAJOR ) { - /* Call LAPACK function and adjust info */ - LAPACK_zgesvdq( &joba, &jobp, &jobr, &jobu, &jobv, &m, &n, a, &lda, s, u, &ldu, v, &ldv, - numrank, iwork, &liwork, cwork, &lcwork, rwork, &lrwork, &info ); - if( info < 0 ) { - info = info - 1; - } - } else if( matrix_layout == LAPACK_ROW_MAJOR ) { - lapack_int nrows_u = ( LAPACKE_lsame( jobu, 'a' ) || - LAPACKE_lsame( jobu, 'u' ) || - LAPACKE_lsame( jobu, 'r' ) || - LAPACKE_lsame( jobu, 'f' ) || - LAPACKE_lsame( jobu, 's' ) ) ? m : 1; - lapack_int ncols_u = LAPACKE_lsame( jobu, 'a' ) ? m : - ( (LAPACKE_lsame( jobu, 's' ) || - LAPACKE_lsame( jobu, 'u' ) ) ? MIN(m,n) : 1); - lapack_int nrows_v = ( LAPACKE_lsame( jobv, 'a' ) || - LAPACKE_lsame( jobv, 'v' ) || - LAPACKE_lsame( jobv, 'r' )) ? n : 1; - lapack_int lda_t = MAX(1,m); - lapack_int ldu_t = MAX(1,nrows_u); - lapack_int ldv_t = MAX(1,nrows_v); - lapack_complex_double* a_t = NULL; - lapack_complex_double* u_t = NULL; - lapack_complex_double* v_t = NULL; - /* Check leading dimension(s) */ - if( lda < n ) { - info = -9; - LAPACKE_xerbla( "LAPACKE_zgesvdq_work", info ); - return info; - } - if( ldu < ncols_u ) { - info = -12; - LAPACKE_xerbla( "LAPACKE_zgesvdq_work", info ); - return info; - } - if( ldv < n ) { - info = -14; - LAPACKE_xerbla( "LAPACKE_zgesvdq_work", info ); - return info; - } - /* Query optimal working array(s) size if requested */ - if( lcwork == -1 ) { - LAPACK_zgesvdq( &joba, &jobp, &jobr, &jobu, &jobv, &m, &n, a, &lda_t, - s, u, &ldu_t, v, &ldv_t, numrank, iwork, &liwork, - cwork, &lcwork, rwork, &lrwork, &info ); - return (info < 0) ? (info - 1) : info; - } - /* Allocate memory for temporary array(s) */ - a_t = (lapack_complex_double*)LAPACKE_malloc( sizeof(lapack_complex_double) * lda_t * MAX(1,n) ); - if( a_t == NULL ) { - info = LAPACK_TRANSPOSE_MEMORY_ERROR; - goto exit_level_0; - } - if( LAPACKE_lsame( jobu, 'a' ) || LAPACKE_lsame( jobu, 's' ) || - LAPACKE_lsame( jobu, 'u' ) || - LAPACKE_lsame( jobu, 'r' ) || - LAPACKE_lsame( jobu, 'f' ) ) { - u_t = (lapack_complex_double*) - LAPACKE_malloc( sizeof(lapack_complex_double) * ldu_t * MAX(1,ncols_u) ); - if( u_t == NULL ) { - info = LAPACK_TRANSPOSE_MEMORY_ERROR; - goto exit_level_1; - } - } - if( LAPACKE_lsame( jobv, 'a' ) || LAPACKE_lsame( jobv, 'v' ) || - LAPACKE_lsame( jobv, 'r' ) ) { - 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_2; - } - } - /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); - /* Call LAPACK function and adjust info */ - LAPACK_zgesvdq( &joba, &jobp, &jobr, &jobu, &jobv, &m, &n, a, &lda_t, - s, u, &ldu_t, v, &ldv_t, numrank, iwork, &liwork, - cwork, &lcwork, rwork, &lrwork, &info ); - if( info < 0 ) { - info = info - 1; - } - /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); - if( LAPACKE_lsame( jobu, 'a' ) || LAPACKE_lsame( jobu, 's' ) || - LAPACKE_lsame( jobu, 'u' ) || - LAPACKE_lsame( jobu, 'r' ) || - LAPACKE_lsame( jobu, 'f' ) ) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, nrows_u, ncols_u, u_t, ldu_t, - u, ldu ); - } - if( LAPACKE_lsame( jobv, 'a' ) || LAPACKE_lsame( jobv, 'v' ) || - LAPACKE_lsame( jobv, 'r' )) { - LAPACKE_zge_trans( LAPACK_COL_MAJOR, nrows_v, n, v_t, ldv_t, v, - ldv ); - } - /* Release memory and exit */ - if( LAPACKE_lsame( jobv, 'a' ) || LAPACKE_lsame( jobv, 'v' ) || - LAPACKE_lsame( jobv, 'r' ) ) { - LAPACKE_free( v_t ); - } -exit_level_2: - if( LAPACKE_lsame( jobu, 'a' ) || LAPACKE_lsame( jobu, 's' ) || - LAPACKE_lsame( jobu, 'u' ) || - LAPACKE_lsame( jobu, 'r' ) || - LAPACKE_lsame( jobu, 'f' ) ) { - LAPACKE_free( u_t ); - } -exit_level_1: - LAPACKE_free( a_t ); -exit_level_0: - if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { - LAPACKE_xerbla( "LAPACKE_zgesvdq_work", info ); - } - } else { - info = -1; - LAPACKE_xerbla( "LAPACKE_zgesvdq_work", info ); - } - return info; -}