From: julie Date: Mon, 5 Oct 2015 01:26:04 +0000 (+0000) Subject: Adding [un/or]csd2by1 routines to LAPACKE X-Git-Tag: accepted/tizen/5.0/unified/20181102.024111~322 X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=c2959d1a5abd7cc60553f7b787410944cdb5f566;p=platform%2Fupstream%2Flapack.git Adding [un/or]csd2by1 routines to LAPACKE --- diff --git a/LAPACKE/include/lapacke.h b/LAPACKE/include/lapacke.h index f386b13..ed5e4e9 100644 --- a/LAPACKE/include/lapacke.h +++ b/LAPACKE/include/lapacke.h @@ -10389,6 +10389,23 @@ lapack_int LAPACKE_cuncsd_work( int matrix_layout, char jobu1, char jobu2, lapack_complex_float* work, lapack_int lwork, float* rwork, lapack_int lrwork, lapack_int* iwork ); +lapack_int LAPACKE_cuncsd2by1( int matrix_layout, char jobu1, char jobu2, + char jobv1t, lapack_int m, lapack_int p, lapack_int q, + lapack_complex_float* x11, lapack_int ldx11, + lapack_complex_float* x21, lapack_int ldx21, + lapack_complex_float* theta, lapack_complex_float* u1, + lapack_int ldu1, lapack_complex_float* u2, + lapack_int ldu2, lapack_complex_float* v1t, lapack_int ldv1t ); +lapack_int LAPACKE_cuncsd2by1_work( int matrix_layout, char jobu1, char jobu2, + char jobv1t, lapack_int m, lapack_int p, + lapack_int q, lapack_complex_float* x11, lapack_int ldx11, + lapack_complex_float* x21, lapack_int ldx21, + lapack_complex_float* theta, lapack_complex_float* u1, + lapack_int ldu1, lapack_complex_float* u2, + lapack_int ldu2, lapack_complex_float* v1t, + lapack_int ldv1t, lapack_complex_float* work, + lapack_int lwork, float* rwork, lapack_int lrwork, + lapack_int* iwork ); lapack_int LAPACKE_dbbcsd( int matrix_layout, char jobu1, char jobu2, char jobv1t, char jobv2t, char trans, lapack_int m, lapack_int p, lapack_int q, double* theta, @@ -10443,6 +10460,17 @@ lapack_int LAPACKE_dorcsd_work( int matrix_layout, char jobu1, char jobu2, lapack_int ldv1t, double* v2t, lapack_int ldv2t, double* work, lapack_int lwork, lapack_int* iwork ); +lapack_int LAPACKE_dorcsd2by1( int matrix_layout, char jobu1, char jobu2, + char jobv1t, lapack_int m, lapack_int p, lapack_int q, + double* x11, lapack_int ldx11, double* x21, lapack_int ldx21, + double* theta, double* u1, lapack_int ldu1, double* u2, + lapack_int ldu2, double* v1t, lapack_int ldv1t); +lapack_int LAPACKE_dorcsd2by1_work( int matrix_layout, char jobu1, char jobu2, + char jobv1t, lapack_int m, lapack_int p, lapack_int q, + double* x11, lapack_int ldx11, double* x21, lapack_int ldx21, + double* theta, double* u1, lapack_int ldu1, double* u2, + lapack_int ldu2, double* v1t, lapack_int ldv1t, + double* work, lapack_int lwork, lapack_int* iwork ); lapack_int LAPACKE_dsyconv( int matrix_layout, char uplo, char way, lapack_int n, double* a, lapack_int lda, const lapack_int* ipiv, double* work); lapack_int LAPACKE_dsyconv_work( int matrix_layout, char uplo, char way, @@ -10525,6 +10553,17 @@ lapack_int LAPACKE_sorcsd_work( int matrix_layout, char jobu1, char jobu2, lapack_int ldv1t, float* v2t, lapack_int ldv2t, float* work, lapack_int lwork, lapack_int* iwork ); +lapack_int LAPACKE_sorcsd2by1( int matrix_layout, char jobu1, char jobu2, + char jobv1t, lapack_int m, lapack_int p, lapack_int q, + float* x11, lapack_int ldx11, float* x21, lapack_int ldx21, + float* theta, float* u1, lapack_int ldu1, float* u2, + lapack_int ldu2, float* v1t, lapack_int ldv1t); +lapack_int LAPACKE_sorcsd2by1_work( int matrix_layout, char jobu1, char jobu2, + char jobv1t, lapack_int m, lapack_int p, lapack_int q, + float* x11, lapack_int ldx11, float* x21, lapack_int ldx21, + float* theta, float* u1, lapack_int ldu1, float* u2, + lapack_int ldu2, float* v1t, lapack_int ldv1t, + float* work, lapack_int lwork, lapack_int* iwork ); lapack_int LAPACKE_ssyconv( int matrix_layout, char uplo, char way, lapack_int n, float* a, lapack_int lda, const lapack_int* ipiv, float* work ); lapack_int LAPACKE_ssyconv_work( int matrix_layout, char uplo, char way, @@ -10691,6 +10730,24 @@ lapack_int LAPACKE_zuncsd_work( int matrix_layout, char jobu1, char jobu2, lapack_complex_double* work, lapack_int lwork, double* rwork, lapack_int lrwork, lapack_int* iwork ); +lapack_int LAPACKE_zuncsd2by1( int matrix_layout, char jobu1, char jobu2, + char jobv1t, lapack_int m, lapack_int p, lapack_int q, + lapack_complex_double* x11, lapack_int ldx11, + lapack_complex_double* x21, lapack_int ldx21, + lapack_complex_double* theta, lapack_complex_double* u1, + lapack_int ldu1, lapack_complex_double* u2, + lapack_int ldu2, lapack_complex_double* v1t, lapack_int ldv1t ); +lapack_int LAPACKE_zuncsd2by1_work( int matrix_layout, char jobu1, char jobu2, + char jobv1t, lapack_int m, lapack_int p, + lapack_int q, lapack_complex_double* x11, lapack_int ldx11, + lapack_complex_double* x21, lapack_int ldx21, + lapack_complex_double* theta, lapack_complex_double* u1, + lapack_int ldu1, lapack_complex_double* u2, + lapack_int ldu2, lapack_complex_double* v1t, + lapack_int ldv1t, lapack_complex_double* work, + lapack_int lwork, double* rwork, lapack_int lrwork, + lapack_int* iwork ); + //LAPACK 3.4.0 lapack_int LAPACKE_sgemqrt( int matrix_layout, char side, char trans, lapack_int m, lapack_int n, lapack_int k, @@ -12175,9 +12232,11 @@ void LAPACKE_ilaver( const lapack_int* vers_major, #define LAPACK_csytrs2 LAPACK_GLOBAL(csytrs2,CSYTRS2) #define LAPACK_cunbdb LAPACK_GLOBAL(cunbdb,CUNBDB) #define LAPACK_cuncsd LAPACK_GLOBAL(cuncsd,CUNCSD) +#define LAPACK_cuncsd2by1 LAPACK_GLOBAL(cuncsd2by1,CUNCSD2BY1) #define LAPACK_dbbcsd LAPACK_GLOBAL(dbbcsd,DBBCSD) #define LAPACK_dorbdb LAPACK_GLOBAL(dorbdb,DORBDB) #define LAPACK_dorcsd LAPACK_GLOBAL(dorcsd,DORCSD) +#define LAPACK_dorcsd2by1 LAPACK_GLOBAL(dorcsd2by1,DORCSD2BY1) #define LAPACK_dsyconv LAPACK_GLOBAL(dsyconv,DSYCONV) #define LAPACK_dsyswapr LAPACK_GLOBAL(dsyswapr,DSYSWAPR) #define LAPACK_dsytri2 LAPACK_GLOBAL(dsytri2,DSYTRI2) @@ -12186,6 +12245,7 @@ void LAPACKE_ilaver( const lapack_int* vers_major, #define LAPACK_sbbcsd LAPACK_GLOBAL(sbbcsd,SBBCSD) #define LAPACK_sorbdb LAPACK_GLOBAL(sorbdb,SORBDB) #define LAPACK_sorcsd LAPACK_GLOBAL(sorcsd,SORCSD) +#define LAPACK_sorcsd2by1 LAPACK_GLOBAL(sorcsd2by1,SORCSD2BY1) #define LAPACK_ssyconv LAPACK_GLOBAL(ssyconv,SSYCONV) #define LAPACK_ssyswapr LAPACK_GLOBAL(ssyswapr,SSYSWAPR) #define LAPACK_ssytri2 LAPACK_GLOBAL(ssytri2,SSYTRI2) @@ -12203,6 +12263,7 @@ void LAPACKE_ilaver( const lapack_int* vers_major, #define LAPACK_zsytrs2 LAPACK_GLOBAL(zsytrs2,ZSYTRS2) #define LAPACK_zunbdb LAPACK_GLOBAL(zunbdb,ZUNBDB) #define LAPACK_zuncsd LAPACK_GLOBAL(zuncsd,ZUNCSD) +#define LAPACK_zuncsd2by1 LAPACK_GLOBAL(zuncsd2by1,ZUNCSD2BY1) // LAPACK 3.4.0 #define LAPACK_sgemqrt LAPACK_GLOBAL(sgemqrt,SGEMQRT) #define LAPACK_dgemqrt LAPACK_GLOBAL(dgemqrt,DGEMQRT) @@ -16761,6 +16822,17 @@ void LAPACK_cuncsd( char* jobu1, char* jobu2, lapack_complex_float* work, lapack_int* lwork, float* rwork, lapack_int* lrwork, lapack_int* iwork , lapack_int *info ); +void LAPACK_cuncsd2by1( char* jobu1, char* jobu2, + char* jobv1t, lapack_int* m, lapack_int* p, + lapack_int* q, lapack_complex_float* x11, + lapack_int* ldx11, lapack_complex_float* x21, + lapack_int* ldx21, lapack_complex_float* theta, + lapack_complex_float* u1, lapack_int* ldu1, + lapack_complex_float* u2, lapack_int* ldu2, + lapack_complex_float* v1t, lapack_int* ldv1t, + lapack_complex_float* work, lapack_int* lwork, + float* rwork, lapack_int* lrwork, + lapack_int* iwork , lapack_int *info ); void LAPACK_dbbcsd( char* jobu1, char* jobu2, char* jobv1t, char* jobv2t, char* trans, lapack_int* m, lapack_int* p, lapack_int* q, @@ -16790,6 +16862,14 @@ void LAPACK_dorcsd( char* jobu1, char* jobu2, lapack_int* ldv1t, double* v2t, lapack_int* ldv2t, double* work, lapack_int* lwork, lapack_int* iwork , lapack_int *info ); +void LAPACK_dorcsd2by1( char* jobu1, char* jobu2, + char* jobv1t, lapack_int* m, lapack_int* p, + lapack_int* q, double* x11, lapack_int* ldx11, + double* x21, lapack_int* ldx21, + double* theta, double* u1, lapack_int* ldu1, + double* u2, lapack_int* ldu2, double* v1t, + lapack_int* ldv1t, double* work, lapack_int* lwork, + lapack_int* iwork , lapack_int *info ); void LAPACK_dsyconv( char* uplo, char* way, lapack_int* n, double* a, lapack_int* lda, const lapack_int* ipiv, double* work , lapack_int *info ); @@ -16836,6 +16916,14 @@ void LAPACK_sorcsd( char* jobu1, char* jobu2, lapack_int* ldv1t, float* v2t, lapack_int* ldv2t, float* work, lapack_int* lwork, lapack_int* iwork , lapack_int *info ); +void LAPACK_sorcsd2by1( char* jobu1, char* jobu2, + char* jobv1t, lapack_int* m, lapack_int* p, + lapack_int* q, float* x11, lapack_int* ldx11, + float* x21, lapack_int* ldx21, + float* theta, float* u1, lapack_int* ldu1, + float* u2, lapack_int* ldu2, float* v1t, + lapack_int* ldv1t, float* work, lapack_int* lwork, + lapack_int* iwork , lapack_int *info ); void LAPACK_ssyconv( char* uplo, char* way, lapack_int* n, float* a, lapack_int* lda, const lapack_int* ipiv, float* work , lapack_int *info ); @@ -16930,6 +17018,17 @@ void LAPACK_zuncsd( char* jobu1, char* jobu2, lapack_complex_double* work, lapack_int* lwork, double* rwork, lapack_int* lrwork, lapack_int* iwork , lapack_int *info ); +void LAPACK_zuncsd2by1( char* jobu1, char* jobu2, + char* jobv1t, lapack_int* m, lapack_int* p, + lapack_int* q, lapack_complex_double* x11, + lapack_int* ldx11, lapack_complex_double* x21, + lapack_int* ldx21, lapack_complex_double* theta, + lapack_complex_double* u1, lapack_int* ldu1, + lapack_complex_double* u2, lapack_int* ldu2, + lapack_complex_double* v1t, lapack_int* ldv1t, + lapack_complex_double* work, lapack_int* lwork, + double* rwork, lapack_int* lrwork, + lapack_int* iwork , lapack_int *info ); // LAPACK 3.4.0 void LAPACK_sgemqrt( char* side, char* trans, lapack_int* m, lapack_int* n, lapack_int* k, lapack_int* nb, const float* v, diff --git a/LAPACKE/src/CMakeLists.txt b/LAPACKE/src/CMakeLists.txt index 47f3d74..e4813fd 100644 --- a/LAPACKE/src/CMakeLists.txt +++ b/LAPACKE/src/CMakeLists.txt @@ -479,6 +479,8 @@ lapacke_cunbdb.c lapacke_cunbdb_work.c lapacke_cuncsd.c lapacke_cuncsd_work.c +lapacke_cuncsd2by1.c +lapacke_cuncsd2by1_work.c lapacke_cungbr.c lapacke_cungbr_work.c lapacke_cunghr.c @@ -715,6 +717,8 @@ lapacke_dopmtr.c lapacke_dopmtr_work.c lapacke_dorbdb.c lapacke_dorbdb_work.c +lapacke_dorcsd2by1.c +lapacke_dorcsd2by1_work.c lapacke_dorcsd.c lapacke_dorcsd_work.c lapacke_dorgbr.c @@ -1217,6 +1221,8 @@ lapacke_sorbdb.c lapacke_sorbdb_work.c lapacke_sorcsd.c lapacke_sorcsd_work.c +lapacke_sorcsd2by1.c +lapacke_sorcsd2by1_work.c lapacke_sorgbr.c lapacke_sorgbr_work.c lapacke_sorghr.c @@ -1991,6 +1997,8 @@ lapacke_zunbdb.c lapacke_zunbdb_work.c lapacke_zuncsd.c lapacke_zuncsd_work.c +lapacke_zuncsd2by1.c +lapacke_zuncsd2by1_work.c lapacke_zungbr.c lapacke_zungbr_work.c lapacke_zunghr.c diff --git a/LAPACKE/src/Makefile b/LAPACKE/src/Makefile index 86a1045..ccdfdbf 100644 --- a/LAPACKE/src/Makefile +++ b/LAPACKE/src/Makefile @@ -513,6 +513,8 @@ lapacke_cunbdb.o \ lapacke_cunbdb_work.o \ lapacke_cuncsd.o \ lapacke_cuncsd_work.o \ +lapacke_cuncsd2by1.o \ +lapacke_cuncsd2by1_work.o \ lapacke_cungbr.o \ lapacke_cungbr_work.o \ lapacke_cunghr.o \ @@ -751,6 +753,8 @@ lapacke_dorbdb.o \ lapacke_dorbdb_work.o \ lapacke_dorcsd.o \ lapacke_dorcsd_work.o \ +lapacke_dorcsd2by1.o \ +lapacke_dorcsd2by1_work.o \ lapacke_dorgbr.o \ lapacke_dorgbr_work.o \ lapacke_dorghr.o \ @@ -1251,6 +1255,8 @@ lapacke_sorbdb.o \ lapacke_sorbdb_work.o \ lapacke_sorcsd.o \ lapacke_sorcsd_work.o \ +lapacke_sorcsd2by1.o \ +lapacke_sorcsd2by1_work.o \ lapacke_sorgbr.o \ lapacke_sorgbr_work.o \ lapacke_sorghr.o \ @@ -2025,6 +2031,8 @@ lapacke_zunbdb.o \ lapacke_zunbdb_work.o \ lapacke_zuncsd.o \ lapacke_zuncsd_work.o \ +lapacke_zuncsd2by1.o \ +lapacke_zuncsd2by1_work.o \ lapacke_zungbr.o \ lapacke_zungbr_work.o \ lapacke_zunghr.o \ diff --git a/LAPACKE/src/lapacke_cuncsd2by1.c b/LAPACKE/src/lapacke_cuncsd2by1.c new file mode 100644 index 0000000..cdd7543 --- /dev/null +++ b/LAPACKE/src/lapacke_cuncsd2by1.c @@ -0,0 +1,112 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native high-level C interface to LAPACK function cuncsd2by1 +* Author: Intel Corporation +* Generated November, 2011 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_cuncsd2by1( int matrix_layout, char jobu1, char jobu2, + char jobv1t, lapack_int m, lapack_int p, lapack_int q, + lapack_complex_float* x11, lapack_int ldx11, + lapack_complex_float* x21, lapack_int ldx21, + lapack_complex_float* theta, lapack_complex_float* u1, + lapack_int ldu1, lapack_complex_float* u2, + lapack_int ldu2, lapack_complex_float* v1t, lapack_int ldv1t ) +{ + lapack_int info = 0; + lapack_int lrwork = -1; + lapack_int lwork = -1; + lapack_int* iwork = NULL; + float* rwork = NULL; + lapack_complex_float* work = NULL; + float rwork_query; + lapack_complex_float work_query; + lapack_int nrows_x11, nrows_x21; + if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { + LAPACKE_xerbla( "LAPACKE_cuncsd2by1", -1 ); + return -1; + } +#ifndef LAPACK_DISABLE_NAN_CHECK + /* Optionally check input matrices for NaNs */ + nrows_x11 = p ; + nrows_x21 = m-p ; + if( LAPACKE_cge_nancheck( matrix_layout, nrows_x11, q, x11, ldx11 ) ) { + return -8; + } + + if( LAPACKE_cge_nancheck( matrix_layout, nrows_x21, q, x21, ldx21 ) ) { + return -9; + } + +#endif + /* Allocate memory for working array(s) */ + iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,m-MIN(MIN(p,m-p),MIN(q,m-q))) ); + if( iwork == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_0; + } + /* Query optimal working array(s) size */ + info = LAPACKE_cuncsd2by1_work( matrix_layout, jobu1, jobu2, jobv1t, m, p, q, + x11, ldx11, x21, ldx21, theta, u1, ldu1, u2, + ldu2, v1t, ldv1t, &work_query, + lwork, &rwork_query, lrwork, iwork ); + if( info != 0 ) { + goto exit_level_2; + } + lrwork = (lapack_int)rwork_query; + lwork = (lapack_int)work_query; + /* Allocate memory for work arrays */ + rwork = (float*)LAPACKE_malloc( sizeof(float) * lrwork ); + if( rwork == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_1; + } + work = (lapack_complex_float*)LAPACKE_malloc( sizeof(lapack_complex_float) * lwork ); + if( work == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_2; + } + /* Call middle-level interface */ + info = LAPACKE_cuncsd2by1_work( matrix_layout, jobu1, jobu2, jobv1t, m, p, q, + x11, ldx11, x21, ldx21, theta, u1, ldu1, u2, + ldu2, v1t, ldv1t, work, lwork, rwork, lrwork, iwork ); + /* Release memory and exit */ + LAPACKE_free( work ); +exit_level_2: + LAPACKE_free( rwork ); +exit_level_1: + LAPACKE_free( iwork ); +exit_level_0: + if( info == LAPACK_WORK_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_cuncsd2by1", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_cuncsd2by1_work.c b/LAPACKE/src/lapacke_cuncsd2by1_work.c new file mode 100644 index 0000000..6584673 --- /dev/null +++ b/LAPACKE/src/lapacke_cuncsd2by1_work.c @@ -0,0 +1,197 @@ +/***************************************************************************** + 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 cuncsd2by1 +* Author: Intel Corporation +* Generated November, 2011 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_cuncsd2by1_work( int matrix_layout, char jobu1, char jobu2, + char jobv1t, lapack_int m, lapack_int p, + lapack_int q, lapack_complex_float* x11, lapack_int ldx11, + lapack_complex_float* x21, lapack_int ldx21, + lapack_complex_float* theta, lapack_complex_float* u1, + lapack_int ldu1, lapack_complex_float* u2, + lapack_int ldu2, lapack_complex_float* v1t, + lapack_int ldv1t, lapack_complex_float* work, + lapack_int lwork, float* rwork, lapack_int lrwork, + lapack_int* iwork ) +{ + lapack_int info = 0; + if( matrix_layout == LAPACK_COL_MAJOR ) { + /* Call LAPACK function and adjust info */ + LAPACK_cuncsd2by1( &jobu1, &jobu2, &jobv1t, &m, &p, + &q, x11, &ldx11, x21, &ldx21, + theta, u1, &ldu1, u2, &ldu2, v1t, &ldv1t, + work, &lwork, rwork, &lrwork, iwork, &info ); + if( info < 0 ) { + info = info - 1; + } + } else if( matrix_layout == LAPACK_ROW_MAJOR ) { + lapack_int nrows_x11 = p; + lapack_int nrows_x21 = m-p; + lapack_int nrows_u1 = ( LAPACKE_lsame( jobu1, 'y' ) ? p : 1); + lapack_int nrows_u2 = ( LAPACKE_lsame( jobu2, 'y' ) ? m-p : 1); + lapack_int nrows_v1t = ( LAPACKE_lsame( jobv1t, 'y' ) ? q : 1); + lapack_int ldu1_t = MAX(1,nrows_u1); + lapack_int ldu2_t = MAX(1,nrows_u2); + lapack_int ldv1t_t = MAX(1,nrows_v1t); + lapack_int ldx11_t = MAX(1,nrows_x11); + lapack_int ldx21_t = MAX(1,nrows_x21); + lapack_complex_float* x11_t = NULL; + lapack_complex_float* x21_t = NULL; + lapack_complex_float* u1_t = NULL; + lapack_complex_float* u2_t = NULL; + lapack_complex_float* v1t_t = NULL; + /* Check leading dimension(s) */ + if( ldu1 < p ) { + info = -21; + LAPACKE_xerbla( "LAPACKE_cuncsd2by1_work", info ); + return info; + } + if( ldu2 < m-p ) { + info = -23; + LAPACKE_xerbla( "LAPACKE_cuncsd2by1_work", info ); + return info; + } + if( ldv1t < q ) { + info = -25; + LAPACKE_xerbla( "LAPACKE_cuncsd2by1_work", info ); + return info; + } + if( ldx11 < q ) { + info = -12; + LAPACKE_xerbla( "LAPACKE_cuncsd2by1_work", info ); + return info; + } + if( ldx21 < q ) { + info = -16; + LAPACKE_xerbla( "LAPACKE_cuncsd2by1_work", info ); + return info; + } + /* Query optimal working array(s) size if requested */ + if( lrwork == -1 || lwork == -1 ) { + LAPACK_cuncsd2by1( &jobu1, &jobu2, &jobv1t, &m, &p, + &q, x11, &ldx11, x21, &ldx21, + theta, u1, &ldu1, u2, &ldu2, v1t, &ldv1t, + work, &lwork, rwork, &lrwork, iwork, &info ); + return (info < 0) ? (info - 1) : info; + } + /* Allocate memory for temporary array(s) */ + x11_t = (lapack_complex_float*)LAPACKE_malloc( sizeof(lapack_complex_float) * ldx11_t * MAX(1,q) ); + if( x11_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_0; + } + x21_t = (lapack_complex_float*)LAPACKE_malloc( sizeof(lapack_complex_float) * ldx21_t * MAX(1,q) ); + if( x21_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_1; + } + if( LAPACKE_lsame( jobu1, 'y' ) ) { + u1_t = (lapack_complex_float*) + LAPACKE_malloc( sizeof(lapack_complex_float) * ldu1_t * MAX(1,p) ); + if( u1_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_2; + } + } + if( LAPACKE_lsame( jobu2, 'y' ) ) { + u2_t = (lapack_complex_float*) + LAPACKE_malloc( sizeof(lapack_complex_float) * ldu2_t * MAX(1,m-p) ); + if( u2_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_3; + } + } + if( LAPACKE_lsame( jobv1t, 'y' ) ) { + v1t_t = (lapack_complex_float*) + LAPACKE_malloc( sizeof(lapack_complex_float) * ldv1t_t * MAX(1,q) ); + if( v1t_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_4; + } + } + /* Transpose input matrices */ + LAPACKE_cge_trans( matrix_layout, nrows_x11, q, x11, ldx11, x11_t, + ldx11_t ); + LAPACKE_cge_trans( matrix_layout, nrows_x21, q, x21, ldx21, x21_t, + ldx21_t ); + /* Call LAPACK function and adjust info */ + LAPACK_cuncsd2by1( &jobu1, &jobu2, &jobv1t, &m, &p, + &q, x11, &ldx11, x21, &ldx21, + theta, u1, &ldu1, u2, &ldu2, v1t, &ldv1t, + work, &lwork, rwork, &lrwork, iwork, &info ); + if( info < 0 ) { + info = info - 1; + } + /* Transpose output matrices */ + LAPACKE_cge_trans( LAPACK_COL_MAJOR, nrows_x11, q, x11_t, ldx11_t, x11, + ldx11 ); + LAPACKE_cge_trans( LAPACK_COL_MAJOR, nrows_x21, q, x21_t, ldx21_t, x21, + ldx21 ); + if( LAPACKE_lsame( jobu1, 'y' ) ) { + LAPACKE_cge_trans( LAPACK_COL_MAJOR, nrows_u1, p, u1_t, ldu1_t, u1, + ldu1 ); + } + if( LAPACKE_lsame( jobu2, 'y' ) ) { + LAPACKE_cge_trans( LAPACK_COL_MAJOR, nrows_u2, m-p, u2_t, ldu2_t, + u2, ldu2 ); + } + if( LAPACKE_lsame( jobv1t, 'y' ) ) { + LAPACKE_cge_trans( LAPACK_COL_MAJOR, nrows_v1t, q, v1t_t, ldv1t_t, + v1t, ldv1t ); + } + /* Release memory and exit */ + if( LAPACKE_lsame( jobv1t, 'y' ) ) { + LAPACKE_free( v1t_t ); + } +exit_level_4: + if( LAPACKE_lsame( jobu2, 'y' ) ) { + LAPACKE_free( u2_t ); + } +exit_level_3: + if( LAPACKE_lsame( jobu1, 'y' ) ) { + LAPACKE_free( u1_t ); + } +exit_level_2: + LAPACKE_free( x21_t ); +exit_level_1: + LAPACKE_free( x11_t ); +exit_level_0: + if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_cuncsd2by1_work", info ); + } + } else { + info = -1; + LAPACKE_xerbla( "LAPACKE_cuncsd2by1_work", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_dorcsd2by1.c b/LAPACKE/src/lapacke_dorcsd2by1.c new file mode 100644 index 0000000..7c71cd4 --- /dev/null +++ b/LAPACKE/src/lapacke_dorcsd2by1.c @@ -0,0 +1,99 @@ +/***************************************************************************** + 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 dorcsd2by1 +* Author: Intel Corporation +* Generated November, 2011 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_dorcsd2by1( int matrix_layout, char jobu1, char jobu2, + char jobv1t, lapack_int m, lapack_int p, lapack_int q, + double* x11, lapack_int ldx11, double* x21, lapack_int ldx21, + double* theta, double* u1, lapack_int ldu1, double* u2, + lapack_int ldu2, double* v1t, lapack_int ldv1t ) +{ + lapack_int info = 0; + lapack_int lwork = -1; + lapack_int* iwork = NULL; + double* work = NULL; + double work_query; + lapack_int nrows_x11, nrows_x21; + if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { + LAPACKE_xerbla( "LAPACKE_dorcsd2by1", -1 ); + return -1; + } +#ifndef LAPACK_DISABLE_NAN_CHECK + /* Optionally check input matrices for NaNs */ + nrows_x11 = p ; + nrows_x21 = m-p ; + if( LAPACKE_dge_nancheck( matrix_layout, nrows_x11, q, x11, ldx11 ) ) { + return -8; + } + + if( LAPACKE_dge_nancheck( matrix_layout, nrows_x21, q, x21, ldx21 ) ) { + return -9; + } + +#endif + /* Allocate memory for working array(s) */ + iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,m-MIN(MIN(p,m-p),MIN(q,m-q))) ); + if( iwork == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_0; + } + /* Query optimal working array(s) size */ + info = LAPACKE_dorcsd2by1_work( matrix_layout, jobu1, jobu2, jobv1t, m, p, q, + x11, ldx11, x21, ldx21, theta, u1, ldu1, u2, + ldu2, v1t, ldv1t, &work_query, + lwork, iwork ); + if( info != 0 ) { + goto exit_level_1; + } + lwork = (lapack_int)work_query; + /* Allocate memory for work arrays */ + work = (double*)LAPACKE_malloc( sizeof(double) * lwork ); + if( work == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_1; + } + /* Call middle-level interface */ + info = LAPACKE_dorcsd2by1_work( matrix_layout, jobu1, jobu2, jobv1t, m, p, q, + x11, ldx11, x21, ldx21, theta, u1, ldu1, u2, + ldu2, v1t, ldv1t, work, lwork, iwork ); + /* Release memory and exit */ + LAPACKE_free( work ); +exit_level_1: + LAPACKE_free( iwork ); +exit_level_0: + if( info == LAPACK_WORK_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_dorcsd2by1", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_dorcsd2by1_work.c b/LAPACKE/src/lapacke_dorcsd2by1_work.c new file mode 100644 index 0000000..8a080fb --- /dev/null +++ b/LAPACKE/src/lapacke_dorcsd2by1_work.c @@ -0,0 +1,195 @@ +/***************************************************************************** + 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 dorcsd2by1 +* Author: Intel Corporation +* Generated November, 2011 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_dorcsd2by1_work( int matrix_layout, char jobu1, char jobu2, + char jobv1t, lapack_int m, lapack_int p, + lapack_int q, double* x11, lapack_int ldx11, + double* x21, lapack_int ldx21, + double* theta, double* u1, lapack_int ldu1, + double* u2, lapack_int ldu2, double* v1t, + lapack_int ldv1t, double* work, lapack_int lwork, + lapack_int* iwork ) +{ + lapack_int info = 0; + if( matrix_layout == LAPACK_COL_MAJOR ) { + /* Call LAPACK function and adjust info */ + LAPACK_dorcsd2by1( &jobu1, &jobu2, &jobv1t, &m, &p, + &q, x11, &ldx11, x21, &ldx21, + theta, u1, &ldu1, u2, &ldu2, v1t, &ldv1t, + work, &lwork, iwork, &info ); + if( info < 0 ) { + info = info - 1; + } + } else if( matrix_layout == LAPACK_ROW_MAJOR ) { + lapack_int nrows_x11 = p; + lapack_int nrows_x21 = m-p; + lapack_int nrows_u1 = ( LAPACKE_lsame( jobu1, 'y' ) ? p : 1); + lapack_int nrows_u2 = ( LAPACKE_lsame( jobu2, 'y' ) ? m-p : 1); + lapack_int nrows_v1t = ( LAPACKE_lsame( jobv1t, 'y' ) ? q : 1); + lapack_int ldu1_t = MAX(1,nrows_u1); + lapack_int ldu2_t = MAX(1,nrows_u2); + lapack_int ldv1t_t = MAX(1,nrows_v1t); + lapack_int ldx11_t = MAX(1,nrows_x11); + lapack_int ldx21_t = MAX(1,nrows_x21); + double* x11_t = NULL; + double* x21_t = NULL; + double* u1_t = NULL; + double* u2_t = NULL; + double* v1t_t = NULL; + /* Check leading dimension(s) */ + if( ldu1 < p ) { + info = -21; + LAPACKE_xerbla( "LAPACKE_dorcsd2by1_work", info ); + return info; + } + if( ldu2 < m-p ) { + info = -23; + LAPACKE_xerbla( "LAPACKE_dorcsd2by1_work", info ); + return info; + } + if( ldv1t < q ) { + info = -25; + LAPACKE_xerbla( "LAPACKE_dorcsd2by1_work", info ); + return info; + } + if( ldx11 < q ) { + info = -12; + LAPACKE_xerbla( "LAPACKE_dorcsd2by1_work", info ); + return info; + } + if( ldx21 < q ) { + info = -16; + LAPACKE_xerbla( "LAPACKE_dorcsd2by1_work", info ); + return info; + } + /* Query optimal working array(s) size if requested */ + if( lwork == -1 ) { + LAPACK_dorcsd2by1( &jobu1, &jobu2, &jobv1t, &m, &p, + &q, x11, &ldx11, x21, &ldx21, + theta, u1, &ldu1, u2, &ldu2, v1t, &ldv1t, + work, &lwork, iwork, &info ); + return (info < 0) ? (info - 1) : info; + } + /* Allocate memory for temporary array(s) */ + x11_t = (double*)LAPACKE_malloc( sizeof(double) * ldx11_t * MAX(1,q) ); + if( x11_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_0; + } + x21_t = (double*)LAPACKE_malloc( sizeof(double) * ldx21_t * MAX(1,q) ); + if( x21_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_1; + } + if( LAPACKE_lsame( jobu1, 'y' ) ) { + u1_t = (double*) + LAPACKE_malloc( sizeof(double) * ldu1_t * MAX(1,p) ); + if( u1_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_2; + } + } + if( LAPACKE_lsame( jobu2, 'y' ) ) { + u2_t = (double*) + LAPACKE_malloc( sizeof(double) * ldu2_t * MAX(1,m-p) ); + if( u2_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_3; + } + } + if( LAPACKE_lsame( jobv1t, 'y' ) ) { + v1t_t = (double*) + LAPACKE_malloc( sizeof(double) * ldv1t_t * MAX(1,q) ); + if( v1t_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_4; + } + } + /* Transpose input matrices */ + LAPACKE_dge_trans( matrix_layout, nrows_x11, q, x11, ldx11, x11_t, + ldx11_t ); + LAPACKE_dge_trans( matrix_layout, nrows_x21, q, x21, ldx21, x21_t, + ldx21_t ); + /* Call LAPACK function and adjust info */ + LAPACK_dorcsd2by1( &jobu1, &jobu2, &jobv1t, &m, &p, + &q, x11, &ldx11, x21, &ldx21, + theta, u1, &ldu1, u2, &ldu2, v1t, &ldv1t, + work, &lwork, iwork, &info ); + if( info < 0 ) { + info = info - 1; + } + /* Transpose output matrices */ + LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrows_x11, q, x11_t, ldx11_t, x11, + ldx11 ); + LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrows_x21, q, x21_t, ldx21_t, x21, + ldx21 ); + if( LAPACKE_lsame( jobu1, 'y' ) ) { + LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrows_u1, p, u1_t, ldu1_t, u1, + ldu1 ); + } + if( LAPACKE_lsame( jobu2, 'y' ) ) { + LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrows_u2, m-p, u2_t, ldu2_t, + u2, ldu2 ); + } + if( LAPACKE_lsame( jobv1t, 'y' ) ) { + LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrows_v1t, q, v1t_t, ldv1t_t, + v1t, ldv1t ); + } + /* Release memory and exit */ + if( LAPACKE_lsame( jobv1t, 'y' ) ) { + LAPACKE_free( v1t_t ); + } +exit_level_4: + if( LAPACKE_lsame( jobu2, 'y' ) ) { + LAPACKE_free( u2_t ); + } +exit_level_3: + if( LAPACKE_lsame( jobu1, 'y' ) ) { + LAPACKE_free( u1_t ); + } +exit_level_2: + LAPACKE_free( x21_t ); +exit_level_1: + LAPACKE_free( x11_t ); +exit_level_0: + if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_dorcsd2by1_work", info ); + } + } else { + info = -1; + LAPACKE_xerbla( "LAPACKE_dorcsd2by1_work", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_sorcsd2by1.c b/LAPACKE/src/lapacke_sorcsd2by1.c new file mode 100644 index 0000000..b924897 --- /dev/null +++ b/LAPACKE/src/lapacke_sorcsd2by1.c @@ -0,0 +1,99 @@ +/***************************************************************************** + 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 sorcsd2by1 +* Author: Intel Corporation +* Generated November, 2011 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_sorcsd2by1( int matrix_layout, char jobu1, char jobu2, + char jobv1t, lapack_int m, lapack_int p, lapack_int q, + float* x11, lapack_int ldx11, float* x21, lapack_int ldx21, + float* theta, float* u1, lapack_int ldu1, float* u2, + lapack_int ldu2, float* v1t, lapack_int ldv1t ) +{ + lapack_int info = 0; + lapack_int lwork = -1; + lapack_int* iwork = NULL; + float* work = NULL; + float work_query; + lapack_int nrows_x11, nrows_x21; + if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { + LAPACKE_xerbla( "LAPACKE_sorcsd2by1", -1 ); + return -1; + } +#ifndef LAPACK_DISABLE_NAN_CHECK + /* Optionally check input matrices for NaNs */ + nrows_x11 = p ; + nrows_x21 = m-p ; + if( LAPACKE_sge_nancheck( matrix_layout, nrows_x11, q, x11, ldx11 ) ) { + return -8; + } + + if( LAPACKE_sge_nancheck( matrix_layout, nrows_x21, q, x21, ldx21 ) ) { + return -9; + } + +#endif + /* Allocate memory for working array(s) */ + iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,m-MIN(MIN(p,m-p),MIN(q,m-q))) ); + if( iwork == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_0; + } + /* Query optimal working array(s) size */ + info = LAPACKE_sorcsd2by1_work( matrix_layout, jobu1, jobu2, jobv1t, m, p, q, + x11, ldx11, x21, ldx21, theta, u1, ldu1, u2, + ldu2, v1t, ldv1t, &work_query, + lwork, iwork ); + if( info != 0 ) { + goto exit_level_1; + } + lwork = (lapack_int)work_query; + /* Allocate memory for work arrays */ + work = (float*)LAPACKE_malloc( sizeof(float) * lwork ); + if( work == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_1; + } + /* Call middle-level interface */ + info = LAPACKE_sorcsd2by1_work( matrix_layout, jobu1, jobu2, jobv1t, m, p, q, + x11, ldx11, x21, ldx21, theta, u1, ldu1, u2, + ldu2, v1t, ldv1t, work, lwork, iwork ); + /* Release memory and exit */ + LAPACKE_free( work ); +exit_level_1: + LAPACKE_free( iwork ); +exit_level_0: + if( info == LAPACK_WORK_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_sorcsd2by1", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_sorcsd2by1_work.c b/LAPACKE/src/lapacke_sorcsd2by1_work.c new file mode 100644 index 0000000..d3d2451 --- /dev/null +++ b/LAPACKE/src/lapacke_sorcsd2by1_work.c @@ -0,0 +1,195 @@ +/***************************************************************************** + 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 sorcsd2by1 +* Author: Intel Corporation +* Generated November, 2011 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_sorcsd2by1_work( int matrix_layout, char jobu1, char jobu2, + char jobv1t, lapack_int m, lapack_int p, + lapack_int q, float* x11, lapack_int ldx11, + float* x21, lapack_int ldx21, + float* theta, float* u1, lapack_int ldu1, + float* u2, lapack_int ldu2, float* v1t, + lapack_int ldv1t, float* work, lapack_int lwork, + lapack_int* iwork ) +{ + lapack_int info = 0; + if( matrix_layout == LAPACK_COL_MAJOR ) { + /* Call LAPACK function and adjust info */ + LAPACK_sorcsd2by1( &jobu1, &jobu2, &jobv1t, &m, &p, + &q, x11, &ldx11, x21, &ldx21, + theta, u1, &ldu1, u2, &ldu2, v1t, &ldv1t, + work, &lwork, iwork, &info ); + if( info < 0 ) { + info = info - 1; + } + } else if( matrix_layout == LAPACK_ROW_MAJOR ) { + lapack_int nrows_x11 = p; + lapack_int nrows_x21 = m-p; + lapack_int nrows_u1 = ( LAPACKE_lsame( jobu1, 'y' ) ? p : 1); + lapack_int nrows_u2 = ( LAPACKE_lsame( jobu2, 'y' ) ? m-p : 1); + lapack_int nrows_v1t = ( LAPACKE_lsame( jobv1t, 'y' ) ? q : 1); + lapack_int ldu1_t = MAX(1,nrows_u1); + lapack_int ldu2_t = MAX(1,nrows_u2); + lapack_int ldv1t_t = MAX(1,nrows_v1t); + lapack_int ldx11_t = MAX(1,nrows_x11); + lapack_int ldx21_t = MAX(1,nrows_x21); + float* x11_t = NULL; + float* x21_t = NULL; + float* u1_t = NULL; + float* u2_t = NULL; + float* v1t_t = NULL; + /* Check leading dimension(s) */ + if( ldu1 < p ) { + info = -21; + LAPACKE_xerbla( "LAPACKE_sorcsd2by1_work", info ); + return info; + } + if( ldu2 < m-p ) { + info = -23; + LAPACKE_xerbla( "LAPACKE_sorcsd2by1_work", info ); + return info; + } + if( ldv1t < q ) { + info = -25; + LAPACKE_xerbla( "LAPACKE_sorcsd2by1_work", info ); + return info; + } + if( ldx11 < q ) { + info = -12; + LAPACKE_xerbla( "LAPACKE_sorcsd2by1_work", info ); + return info; + } + if( ldx21 < q ) { + info = -16; + LAPACKE_xerbla( "LAPACKE_sorcsd2by1_work", info ); + return info; + } + /* Query optimal working array(s) size if requested */ + if( lwork == -1 ) { + LAPACK_sorcsd2by1( &jobu1, &jobu2, &jobv1t, &m, &p, + &q, x11, &ldx11, x21, &ldx21, + theta, u1, &ldu1, u2, &ldu2, v1t, &ldv1t, + work, &lwork, iwork, &info ); + return (info < 0) ? (info - 1) : info; + } + /* Allocate memory for temporary array(s) */ + x11_t = (float*)LAPACKE_malloc( sizeof(float) * ldx11_t * MAX(1,q) ); + if( x11_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_0; + } + x21_t = (float*)LAPACKE_malloc( sizeof(float) * ldx21_t * MAX(1,q) ); + if( x21_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_1; + } + if( LAPACKE_lsame( jobu1, 'y' ) ) { + u1_t = (float*) + LAPACKE_malloc( sizeof(float) * ldu1_t * MAX(1,p) ); + if( u1_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_2; + } + } + if( LAPACKE_lsame( jobu2, 'y' ) ) { + u2_t = (float*) + LAPACKE_malloc( sizeof(float) * ldu2_t * MAX(1,m-p) ); + if( u2_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_3; + } + } + if( LAPACKE_lsame( jobv1t, 'y' ) ) { + v1t_t = (float*) + LAPACKE_malloc( sizeof(float) * ldv1t_t * MAX(1,q) ); + if( v1t_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_4; + } + } + /* Transpose input matrices */ + LAPACKE_sge_trans( matrix_layout, nrows_x11, q, x11, ldx11, x11_t, + ldx11_t ); + LAPACKE_sge_trans( matrix_layout, nrows_x21, q, x21, ldx21, x21_t, + ldx21_t ); + /* Call LAPACK function and adjust info */ + LAPACK_sorcsd2by1( &jobu1, &jobu2, &jobv1t, &m, &p, + &q, x11, &ldx11, x21, &ldx21, + theta, u1, &ldu1, u2, &ldu2, v1t, &ldv1t, + work, &lwork, iwork, &info ); + if( info < 0 ) { + info = info - 1; + } + /* Transpose output matrices */ + LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_x11, q, x11_t, ldx11_t, x11, + ldx11 ); + LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_x21, q, x21_t, ldx21_t, x21, + ldx21 ); + if( LAPACKE_lsame( jobu1, 'y' ) ) { + LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_u1, p, u1_t, ldu1_t, u1, + ldu1 ); + } + if( LAPACKE_lsame( jobu2, 'y' ) ) { + LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_u2, m-p, u2_t, ldu2_t, + u2, ldu2 ); + } + if( LAPACKE_lsame( jobv1t, 'y' ) ) { + LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_v1t, q, v1t_t, ldv1t_t, + v1t, ldv1t ); + } + /* Release memory and exit */ + if( LAPACKE_lsame( jobv1t, 'y' ) ) { + LAPACKE_free( v1t_t ); + } +exit_level_4: + if( LAPACKE_lsame( jobu2, 'y' ) ) { + LAPACKE_free( u2_t ); + } +exit_level_3: + if( LAPACKE_lsame( jobu1, 'y' ) ) { + LAPACKE_free( u1_t ); + } +exit_level_2: + LAPACKE_free( x21_t ); +exit_level_1: + LAPACKE_free( x11_t ); +exit_level_0: + if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_sorcsd2by1_work", info ); + } + } else { + info = -1; + LAPACKE_xerbla( "LAPACKE_sorcsd2by1_work", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_zuncsd2by1.c b/LAPACKE/src/lapacke_zuncsd2by1.c new file mode 100644 index 0000000..1dfd367 --- /dev/null +++ b/LAPACKE/src/lapacke_zuncsd2by1.c @@ -0,0 +1,112 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native high-level C interface to LAPACK function zuncsd2by1 +* Author: Intel Corporation +* Generated November, 2011 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_zuncsd2by1( int matrix_layout, char jobu1, char jobu2, + char jobv1t, lapack_int m, lapack_int p, lapack_int q, + lapack_complex_double* x11, lapack_int ldx11, + lapack_complex_double* x21, lapack_int ldx21, + lapack_complex_double* theta, lapack_complex_double* u1, + lapack_int ldu1, lapack_complex_double* u2, + lapack_int ldu2, lapack_complex_double* v1t, lapack_int ldv1t ) +{ + lapack_int info = 0; + lapack_int lrwork = -1; + lapack_int lwork = -1; + lapack_int* iwork = NULL; + double* rwork = NULL; + lapack_complex_double* work = NULL; + double rwork_query; + lapack_complex_double work_query; + lapack_int nrows_x11, nrows_x21; + if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { + LAPACKE_xerbla( "LAPACKE_zuncsd2by1", -1 ); + return -1; + } +#ifndef LAPACK_DISABLE_NAN_CHECK + /* Optionally check input matrices for NaNs */ + nrows_x11 = p ; + nrows_x21 = m-p ; + if( LAPACKE_Zge_nancheck( matrix_layout, nrows_x11, q, x11, ldx11 ) ) { + return -8; + } + + if( LAPACKE_Zge_nancheck( matrix_layout, nrows_x21, q, x21, ldx21 ) ) { + return -9; + } + +#endif + /* Allocate memory for working array(s) */ + iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,m-MIN(MIN(p,m-p),MIN(q,m-q))) ); + if( iwork == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_0; + } + /* Query optimal working array(s) size */ + info = LAPACKE_zuncsd2by1_work( matrix_layout, jobu1, jobu2, jobv1t, m, p, q, + x11, ldx11, x21, ldx21, theta, u1, ldu1, u2, + ldu2, v1t, ldv1t, &work_query, + lwork, &rwork_query, lrwork, iwork ); + if( info != 0 ) { + goto exit_level_2; + } + lrwork = (lapack_int)rwork_query; + lwork = (lapack_int)work_query; + /* Allocate memory for work arrays */ + rwork = (double*)LAPACKE_malloc( sizeof(double) * lrwork ); + if( rwork == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_1; + } + work = (lapack_complex_double*)LAPACKE_malloc( sizeof(lapack_complex_double) * lwork ); + if( work == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_2; + } + /* Call middle-level interface */ + info = LAPACKE_zuncsd2by1_work( matrix_layout, jobu1, jobu2, jobv1t, m, p, q, + x11, ldx11, x21, ldx21, theta, u1, ldu1, u2, + ldu2, v1t, ldv1t, work, lwork, rwork, lrwork, iwork ); + /* Release memory and exit */ + LAPACKE_free( work ); +exit_level_2: + LAPACKE_free( rwork ); +exit_level_1: + LAPACKE_free( iwork ); +exit_level_0: + if( info == LAPACK_WORK_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_zuncsd2by1", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_zuncsd2by1_work.c b/LAPACKE/src/lapacke_zuncsd2by1_work.c new file mode 100644 index 0000000..a3b3f85 --- /dev/null +++ b/LAPACKE/src/lapacke_zuncsd2by1_work.c @@ -0,0 +1,197 @@ +/***************************************************************************** + 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 zuncsd2by1 +* Author: Intel Corporation +* Generated November, 2011 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_zuncsd2by1_work( int matrix_layout, char jobu1, char jobu2, + char jobv1t, lapack_int m, lapack_int p, + lapack_int q, lapack_complex_double* x11, lapack_int ldx11, + lapack_complex_double* x21, lapack_int ldx21, + lapack_complex_double* theta, lapack_complex_double* u1, + lapack_int ldu1, lapack_complex_double* u2, + lapack_int ldu2, lapack_complex_double* v1t, + lapack_int ldv1t, lapack_complex_double* work, + lapack_int lwork, double* rwork, lapack_int lrwork, + lapack_int* iwork ) +{ + lapack_int info = 0; + if( matrix_layout == LAPACK_COL_MAJOR ) { + /* Call LAPACK function and adjust info */ + LAPACK_zuncsd2by1( &jobu1, &jobu2, &jobv1t, &m, &p, + &q, x11, &ldx11, x21, &ldx21, + theta, u1, &ldu1, u2, &ldu2, v1t, &ldv1t, + work, &lwork, rwork, &lrwork, iwork, &info ); + if( info < 0 ) { + info = info - 1; + } + } else if( matrix_layout == LAPACK_ROW_MAJOR ) { + lapack_int nrows_x11 = p; + lapack_int nrows_x21 = m-p; + lapack_int nrows_u1 = ( LAPACKE_lsame( jobu1, 'y' ) ? p : 1); + lapack_int nrows_u2 = ( LAPACKE_lsame( jobu2, 'y' ) ? m-p : 1); + lapack_int nrows_v1t = ( LAPACKE_lsame( jobv1t, 'y' ) ? q : 1); + lapack_int ldu1_t = MAX(1,nrows_u1); + lapack_int ldu2_t = MAX(1,nrows_u2); + lapack_int ldv1t_t = MAX(1,nrows_v1t); + lapack_int ldx11_t = MAX(1,nrows_x11); + lapack_int ldx21_t = MAX(1,nrows_x21); + lapack_complex_double* x11_t = NULL; + lapack_complex_double* x21_t = NULL; + lapack_complex_double* u1_t = NULL; + lapack_complex_double* u2_t = NULL; + lapack_complex_double* v1t_t = NULL; + /* Check leading dimension(s) */ + if( ldu1 < p ) { + info = -21; + LAPACKE_xerbla( "LAPACKE_zuncsd2by1_work", info ); + return info; + } + if( ldu2 < m-p ) { + info = -23; + LAPACKE_xerbla( "LAPACKE_zuncsd2by1_work", info ); + return info; + } + if( ldv1t < q ) { + info = -25; + LAPACKE_xerbla( "LAPACKE_zuncsd2by1_work", info ); + return info; + } + if( ldx11 < q ) { + info = -12; + LAPACKE_xerbla( "LAPACKE_zuncsd2by1_work", info ); + return info; + } + if( ldx21 < q ) { + info = -16; + LAPACKE_xerbla( "LAPACKE_zuncsd2by1_work", info ); + return info; + } + /* Query optimal working array(s) size if requested */ + if( lrwork == -1 || lwork == -1 ) { + LAPACK_zuncsd2by1( &jobu1, &jobu2, &jobv1t, &m, &p, + &q, x11, &ldx11, x21, &ldx21, + theta, u1, &ldu1, u2, &ldu2, v1t, &ldv1t, + work, &lwork, rwork, &lrwork, iwork, &info ); + return (info < 0) ? (info - 1) : info; + } + /* Allocate memory for temporary array(s) */ + x11_t = (lapack_complex_double*)LAPACKE_malloc( sizeof(lapack_complex_double) * ldx11_t * MAX(1,q) ); + if( x11_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_0; + } + x21_t = (lapack_complex_double*)LAPACKE_malloc( sizeof(lapack_complex_double) * ldx21_t * MAX(1,q) ); + if( x21_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_1; + } + if( LAPACKE_lsame( jobu1, 'y' ) ) { + u1_t = (lapack_complex_double*) + LAPACKE_malloc( sizeof(lapack_complex_double) * ldu1_t * MAX(1,p) ); + if( u1_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_2; + } + } + if( LAPACKE_lsame( jobu2, 'y' ) ) { + u2_t = (lapack_complex_double*) + LAPACKE_malloc( sizeof(lapack_complex_double) * ldu2_t * MAX(1,m-p) ); + if( u2_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_3; + } + } + if( LAPACKE_lsame( jobv1t, 'y' ) ) { + v1t_t = (lapack_complex_double*) + LAPACKE_malloc( sizeof(lapack_complex_double) * ldv1t_t * MAX(1,q) ); + if( v1t_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_4; + } + } + /* Transpose input matrices */ + LAPACKE_Zge_trans( matrix_layout, nrows_x11, q, x11, ldx11, x11_t, + ldx11_t ); + LAPACKE_Zge_trans( matrix_layout, nrows_x21, q, x21, ldx21, x21_t, + ldx21_t ); + /* Call LAPACK function and adjust info */ + LAPACK_zuncsd2by1( &jobu1, &jobu2, &jobv1t, &m, &p, + &q, x11, &ldx11, x21, &ldx21, + theta, u1, &ldu1, u2, &ldu2, v1t, &ldv1t, + work, &lwork, rwork, &lrwork, iwork, &info ); + if( info < 0 ) { + info = info - 1; + } + /* Transpose output matrices */ + LAPACKE_Zge_trans( LAPACK_COL_MAJOR, nrows_x11, q, x11_t, ldx11_t, x11, + ldx11 ); + LAPACKE_Zge_trans( LAPACK_COL_MAJOR, nrows_x21, q, x21_t, ldx21_t, x21, + ldx21 ); + if( LAPACKE_lsame( jobu1, 'y' ) ) { + LAPACKE_Zge_trans( LAPACK_COL_MAJOR, nrows_u1, p, u1_t, ldu1_t, u1, + ldu1 ); + } + if( LAPACKE_lsame( jobu2, 'y' ) ) { + LAPACKE_Zge_trans( LAPACK_COL_MAJOR, nrows_u2, m-p, u2_t, ldu2_t, + u2, ldu2 ); + } + if( LAPACKE_lsame( jobv1t, 'y' ) ) { + LAPACKE_Zge_trans( LAPACK_COL_MAJOR, nrows_v1t, q, v1t_t, ldv1t_t, + v1t, ldv1t ); + } + /* Release memory and exit */ + if( LAPACKE_lsame( jobv1t, 'y' ) ) { + LAPACKE_free( v1t_t ); + } +exit_level_4: + if( LAPACKE_lsame( jobu2, 'y' ) ) { + LAPACKE_free( u2_t ); + } +exit_level_3: + if( LAPACKE_lsame( jobu1, 'y' ) ) { + LAPACKE_free( u1_t ); + } +exit_level_2: + LAPACKE_free( x21_t ); +exit_level_1: + LAPACKE_free( x11_t ); +exit_level_0: + if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_zuncsd2by1_work", info ); + } + } else { + info = -1; + LAPACKE_xerbla( "LAPACKE_zuncsd2by1_work", info ); + } + return info; +}