diff --git a/lapack-netlib/LAPACKE/src/lapacke_zgejsv.c b/lapack-netlib/LAPACKE/src/lapacke_zgejsv.c index f3b5110a7..153efb371 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_zgejsv.c +++ b/lapack-netlib/LAPACKE/src/lapacke_zgejsv.c @@ -124,7 +124,6 @@ lapack_int LAPACKE_zgejsv( int matrix_layout, char joba, char jobu, char jobv, double* rwork = NULL; lapack_complex_double* cwork = NULL; lapack_int i; - lapack_int nu, nv; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { LAPACKE_xerbla( "LAPACKE_zgejsv", -1 ); return -1; @@ -132,8 +131,6 @@ lapack_int LAPACKE_zgejsv( int matrix_layout, char joba, char jobu, char jobv, #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - nu = LAPACKE_lsame( jobu, 'n' ) ? 1 : m; - nv = LAPACKE_lsame( jobv, 'n' ) ? 1 : n; if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) { return -10; } diff --git a/lapack-netlib/LAPACKE/src/lapacke_zgelsd.c b/lapack-netlib/LAPACKE/src/lapacke_zgelsd.c index 6d111c69f..eca145090 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_zgelsd.c +++ b/lapack-netlib/LAPACKE/src/lapacke_zgelsd.c @@ -75,7 +75,7 @@ lapack_int LAPACKE_zgelsd( int matrix_layout, lapack_int m, lapack_int n, if( info != 0 ) { goto exit_level_0; } - liwork = (lapack_int)iwork_query; + liwork = iwork_query; lrwork = (lapack_int)rwork_query; lwork = LAPACK_Z2INT( work_query ); /* Allocate memory for work arrays */ diff --git a/lapack-netlib/LAPACKE/src/lapacke_zgesvdq.c b/lapack-netlib/LAPACKE/src/lapacke_zgesvdq.c new file mode 100644 index 000000000..f58a5c4e9 --- /dev/null +++ b/lapack-netlib/LAPACKE/src/lapacke_zgesvdq.c @@ -0,0 +1,106 @@ +/***************************************************************************** + 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 zgesvdq +* Author: Intel Corporation +* Generated November 2018 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_zgesvdq( 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 info = 0; + lapack_int liwork = -1; + lapack_int* iwork = NULL; + lapack_int iwork_query; + lapack_int lcwork = -1; + lapack_complex_double* cwork = NULL; + lapack_complex_double cwork_query; + lapack_int lrwork = -1; + double* rwork = NULL; + double rwork_query; + lapack_int i; + if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { + LAPACKE_xerbla( "LAPACKE_zgesvdq", -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, a, lda ) ) { + return -6; + } + } +#endif + /* Query optimal working array(s) size */ + info = LAPACKE_zgesvdq_work( matrix_layout, joba, jobp, jobr, jobu, jobv, + m, n, a, lda, s, u, ldu, v, ldv, numrank, + &iwork_query, liwork, &cwork_query, lcwork, + &rwork_query, lrwork ); + if( info != 0 ) { + goto exit_level_0; + } + liwork = iwork_query; + lcwork = LAPACK_C2INT(cwork_query); + lrwork = (lapack_int)rwork_query; + /* Allocate memory for work arrays */ + iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork ); + if( iwork == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_0; + } + cwork = (lapack_complex_double*)LAPACKE_malloc( sizeof(lapack_complex_double) * lcwork ); + if( cwork == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_0; + } + rwork = (double*)LAPACKE_malloc( sizeof(double) * lrwork ); + if( rwork == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_0; + } + /* Call middle-level interface */ + info = LAPACKE_zgesvdq_work( matrix_layout, joba, jobp, jobr, jobu, jobv, + m, n, a, lda, s, u, ldu, v, ldv, numrank, + iwork, liwork, cwork, lcwork, rwork, lrwork ); + + /* Release memory and exit */ + LAPACKE_free( iwork ); + LAPACKE_free( cwork ); + LAPACKE_free( rwork ); +exit_level_0: + if( info == LAPACK_WORK_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_zgesvdq", info ); + } + return info; +} diff --git a/lapack-netlib/LAPACKE/src/lapacke_zgesvdq_work.c b/lapack-netlib/LAPACKE/src/lapacke_zgesvdq_work.c new file mode 100644 index 000000000..5824de4e0 --- /dev/null +++ b/lapack-netlib/LAPACKE/src/lapacke_zgesvdq_work.c @@ -0,0 +1,149 @@ +/***************************************************************************** + 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 +* Generated November 2015 +*****************************************************************************/ + +#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, 's' ) ) ? m : 1; + lapack_int ncols_u = LAPACKE_lsame( jobu, 'a' ) ? m : + (LAPACKE_lsame( jobu, 's' ) ? MIN(m,n) : 1); + lapack_int nrows_v = LAPACKE_lsame( jobv, 'a' ) ? n : + ( LAPACKE_lsame( jobv, 's' ) ? MIN(m,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' ) ) { + 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, 's' ) ) { + 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_zge_trans( LAPACK_COL_MAJOR, nrows_u, ncols_u, u_t, ldu_t, + u, ldu ); + } + if( LAPACKE_lsame( jobv, 'a' ) || LAPACKE_lsame( jobv, 's' ) ) { + 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, 's' ) ) { + LAPACKE_free( v_t ); + } +exit_level_2: + if( LAPACKE_lsame( jobu, 'a' ) || LAPACKE_lsame( jobu, 's' ) ) { + 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; +} diff --git a/lapack-netlib/LAPACKE/src/lapacke_zggesx.c b/lapack-netlib/LAPACKE/src/lapacke_zggesx.c index 6b4d27045..53e086753 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_zggesx.c +++ b/lapack-netlib/LAPACKE/src/lapacke_zggesx.c @@ -91,7 +91,7 @@ lapack_int LAPACKE_zggesx( int matrix_layout, char jobvsl, char jobvsr, if( info != 0 ) { goto exit_level_2; } - liwork = (lapack_int)iwork_query; + liwork = iwork_query; lwork = LAPACK_Z2INT( work_query ); /* Allocate memory for work arrays */ iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork ); diff --git a/lapack-netlib/LAPACKE/src/lapacke_zhbevd.c b/lapack-netlib/LAPACKE/src/lapacke_zhbevd.c index 95c6d3a54..ac9467496 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_zhbevd.c +++ b/lapack-netlib/LAPACKE/src/lapacke_zhbevd.c @@ -67,7 +67,7 @@ lapack_int LAPACKE_zhbevd( int matrix_layout, char jobz, char uplo, lapack_int n if( info != 0 ) { goto exit_level_0; } - liwork = (lapack_int)iwork_query; + liwork = iwork_query; lrwork = (lapack_int)rwork_query; lwork = LAPACK_Z2INT( work_query ); /* Allocate memory for work arrays */ diff --git a/lapack-netlib/LAPACKE/src/lapacke_zhbevd_2stage.c b/lapack-netlib/LAPACKE/src/lapacke_zhbevd_2stage.c index eca867b28..9b6005b2d 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_zhbevd_2stage.c +++ b/lapack-netlib/LAPACKE/src/lapacke_zhbevd_2stage.c @@ -67,7 +67,7 @@ lapack_int LAPACKE_zhbevd_2stage( int matrix_layout, char jobz, char uplo, lapac if( info != 0 ) { goto exit_level_0; } - liwork = (lapack_int)iwork_query; + liwork = iwork_query; lrwork = (lapack_int)rwork_query; lwork = LAPACK_Z2INT( work_query ); /* Allocate memory for work arrays */ diff --git a/lapack-netlib/LAPACKE/src/lapacke_zhbgvd.c b/lapack-netlib/LAPACKE/src/lapacke_zhbgvd.c index 91bfc0a73..76c3bac3a 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_zhbgvd.c +++ b/lapack-netlib/LAPACKE/src/lapacke_zhbgvd.c @@ -71,7 +71,7 @@ lapack_int LAPACKE_zhbgvd( int matrix_layout, char jobz, char uplo, lapack_int n if( info != 0 ) { goto exit_level_0; } - liwork = (lapack_int)iwork_query; + liwork = iwork_query; lrwork = (lapack_int)rwork_query; lwork = LAPACK_Z2INT( work_query ); /* Allocate memory for work arrays */ diff --git a/lapack-netlib/LAPACKE/src/lapacke_zheev_work.c b/lapack-netlib/LAPACKE/src/lapacke_zheev_work.c index 32b4a76f0..ce278b272 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_zheev_work.c +++ b/lapack-netlib/LAPACKE/src/lapacke_zheev_work.c @@ -70,7 +70,7 @@ lapack_int LAPACKE_zheev_work( int matrix_layout, char jobz, char uplo, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); + LAPACKE_zhe_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zheev( &jobz, &uplo, &n, a_t, &lda_t, w, work, &lwork, rwork, &info ); @@ -78,7 +78,7 @@ lapack_int LAPACKE_zheev_work( int matrix_layout, char jobz, char uplo, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + LAPACKE_zhe_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: diff --git a/lapack-netlib/LAPACKE/src/lapacke_zheevd.c b/lapack-netlib/LAPACKE/src/lapacke_zheevd.c index 4b1afb95c..1305ebfb3 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_zheevd.c +++ b/lapack-netlib/LAPACKE/src/lapacke_zheevd.c @@ -53,7 +53,7 @@ lapack_int LAPACKE_zheevd( int matrix_layout, char jobz, char uplo, lapack_int n #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) { return -5; } } @@ -65,7 +65,7 @@ lapack_int LAPACKE_zheevd( int matrix_layout, char jobz, char uplo, lapack_int n if( info != 0 ) { goto exit_level_0; } - liwork = (lapack_int)iwork_query; + liwork = iwork_query; lrwork = (lapack_int)rwork_query; lwork = LAPACK_Z2INT( work_query ); /* Allocate memory for work arrays */ diff --git a/lapack-netlib/LAPACKE/src/lapacke_zheevd_2stage.c b/lapack-netlib/LAPACKE/src/lapacke_zheevd_2stage.c index 9016da54c..63f139435 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_zheevd_2stage.c +++ b/lapack-netlib/LAPACKE/src/lapacke_zheevd_2stage.c @@ -53,7 +53,7 @@ lapack_int LAPACKE_zheevd_2stage( int matrix_layout, char jobz, char uplo, lapac #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ - if( LAPACKE_zge_nancheck( matrix_layout, n, n, a, lda ) ) { + if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) { return -5; } } @@ -65,7 +65,7 @@ lapack_int LAPACKE_zheevd_2stage( int matrix_layout, char jobz, char uplo, lapac if( info != 0 ) { goto exit_level_0; } - liwork = (lapack_int)iwork_query; + liwork = iwork_query; lrwork = (lapack_int)rwork_query; lwork = LAPACK_Z2INT( work_query ); /* Allocate memory for work arrays */ diff --git a/lapack-netlib/LAPACKE/src/lapacke_zheevd_2stage_work.c b/lapack-netlib/LAPACKE/src/lapacke_zheevd_2stage_work.c index d4b648ee1..bf2e2c828 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_zheevd_2stage_work.c +++ b/lapack-netlib/LAPACKE/src/lapacke_zheevd_2stage_work.c @@ -71,7 +71,7 @@ lapack_int LAPACKE_zheevd_2stage_work( int matrix_layout, char jobz, char uplo, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); + LAPACKE_zhe_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zheevd_2stage( &jobz, &uplo, &n, a_t, &lda_t, w, work, &lwork, rwork, &lrwork, iwork, &liwork, &info ); @@ -79,7 +79,7 @@ lapack_int LAPACKE_zheevd_2stage_work( int matrix_layout, char jobz, char uplo, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + LAPACKE_zhe_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: diff --git a/lapack-netlib/LAPACKE/src/lapacke_zheevd_work.c b/lapack-netlib/LAPACKE/src/lapacke_zheevd_work.c index 9672e6a22..f09cfe49d 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_zheevd_work.c +++ b/lapack-netlib/LAPACKE/src/lapacke_zheevd_work.c @@ -71,7 +71,7 @@ lapack_int LAPACKE_zheevd_work( int matrix_layout, char jobz, char uplo, goto exit_level_0; } /* Transpose input matrices */ - LAPACKE_zge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); + LAPACKE_zhe_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zheevd( &jobz, &uplo, &n, a_t, &lda_t, w, work, &lwork, rwork, &lrwork, iwork, &liwork, &info ); @@ -79,7 +79,7 @@ lapack_int LAPACKE_zheevd_work( int matrix_layout, char jobz, char uplo, info = info - 1; } /* Transpose output matrices */ - LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); + LAPACKE_zhe_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: diff --git a/lapack-netlib/LAPACKE/src/lapacke_zheevr.c b/lapack-netlib/LAPACKE/src/lapacke_zheevr.c index 52e7a5bee..0d26dc2f9 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_zheevr.c +++ b/lapack-netlib/LAPACKE/src/lapacke_zheevr.c @@ -83,7 +83,7 @@ lapack_int LAPACKE_zheevr( int matrix_layout, char jobz, char range, char uplo, if( info != 0 ) { goto exit_level_0; } - liwork = (lapack_int)iwork_query; + liwork = iwork_query; lrwork = (lapack_int)rwork_query; lwork = LAPACK_Z2INT( work_query ); /* Allocate memory for work arrays */ diff --git a/lapack-netlib/LAPACKE/src/lapacke_zheevr_2stage.c b/lapack-netlib/LAPACKE/src/lapacke_zheevr_2stage.c index faf949aef..6fa69c44b 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_zheevr_2stage.c +++ b/lapack-netlib/LAPACKE/src/lapacke_zheevr_2stage.c @@ -83,7 +83,7 @@ lapack_int LAPACKE_zheevr_2stage( int matrix_layout, char jobz, char range, char if( info != 0 ) { goto exit_level_0; } - liwork = (lapack_int)iwork_query; + liwork = iwork_query; lrwork = (lapack_int)rwork_query; lwork = LAPACK_Z2INT( work_query ); /* Allocate memory for work arrays */ diff --git a/lapack-netlib/LAPACKE/src/lapacke_zhegst.c b/lapack-netlib/LAPACKE/src/lapacke_zhegst.c index aa2d84d84..8c4a5c374 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_zhegst.c +++ b/lapack-netlib/LAPACKE/src/lapacke_zhegst.c @@ -35,7 +35,7 @@ lapack_int LAPACKE_zhegst( int matrix_layout, lapack_int itype, char uplo, lapack_int n, lapack_complex_double* a, - lapack_int lda, const lapack_complex_double* b, + lapack_int lda, lapack_complex_double* b, lapack_int ldb ) { if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { diff --git a/lapack-netlib/LAPACKE/src/lapacke_zhegst_work.c b/lapack-netlib/LAPACKE/src/lapacke_zhegst_work.c index f77894204..62fce1f27 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_zhegst_work.c +++ b/lapack-netlib/LAPACKE/src/lapacke_zhegst_work.c @@ -35,7 +35,7 @@ lapack_int LAPACKE_zhegst_work( int matrix_layout, lapack_int itype, char uplo, lapack_int n, lapack_complex_double* a, - lapack_int lda, const lapack_complex_double* b, + lapack_int lda, lapack_complex_double* b, lapack_int ldb ) { lapack_int info = 0; diff --git a/lapack-netlib/LAPACKE/src/lapacke_zhegvd.c b/lapack-netlib/LAPACKE/src/lapacke_zhegvd.c index 81c3d29b4..1242a0eda 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_zhegvd.c +++ b/lapack-netlib/LAPACKE/src/lapacke_zhegvd.c @@ -70,7 +70,7 @@ lapack_int LAPACKE_zhegvd( int matrix_layout, lapack_int itype, char jobz, if( info != 0 ) { goto exit_level_0; } - liwork = (lapack_int)iwork_query; + liwork = iwork_query; lrwork = (lapack_int)rwork_query; lwork = LAPACK_Z2INT( work_query ); /* Allocate memory for work arrays */ diff --git a/lapack-netlib/LAPACKE/src/lapacke_zhpevd.c b/lapack-netlib/LAPACKE/src/lapacke_zhpevd.c index 948bb9c10..a470ca3bb 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_zhpevd.c +++ b/lapack-netlib/LAPACKE/src/lapacke_zhpevd.c @@ -66,7 +66,7 @@ lapack_int LAPACKE_zhpevd( int matrix_layout, char jobz, char uplo, lapack_int n if( info != 0 ) { goto exit_level_0; } - liwork = (lapack_int)iwork_query; + liwork = iwork_query; lrwork = (lapack_int)rwork_query; lwork = LAPACK_Z2INT( work_query ); /* Allocate memory for work arrays */ diff --git a/lapack-netlib/LAPACKE/src/lapacke_zhpgvd.c b/lapack-netlib/LAPACKE/src/lapacke_zhpgvd.c index be18d3313..91fa26443 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_zhpgvd.c +++ b/lapack-netlib/LAPACKE/src/lapacke_zhpgvd.c @@ -70,7 +70,7 @@ lapack_int LAPACKE_zhpgvd( int matrix_layout, lapack_int itype, char jobz, if( info != 0 ) { goto exit_level_0; } - liwork = (lapack_int)iwork_query; + liwork = iwork_query; lrwork = (lapack_int)rwork_query; lwork = LAPACK_Z2INT( work_query ); /* Allocate memory for work arrays */ diff --git a/lapack-netlib/LAPACKE/src/lapacke_zlantr_work.c b/lapack-netlib/LAPACKE/src/lapacke_zlantr_work.c index 0d8bcf550..e62f8a4e3 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_zlantr_work.c +++ b/lapack-netlib/LAPACKE/src/lapacke_zlantr_work.c @@ -43,12 +43,10 @@ double LAPACKE_zlantr_work( int matrix_layout, char norm, char uplo, if( matrix_layout == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ res = LAPACK_zlantr( &norm, &uplo, &diag, &m, &n, a, &lda, work ); - if( info < 0 ) { - info = info - 1; - } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { lapack_int lda_t = MAX(1,m); lapack_complex_double* a_t = NULL; + double* work_lapack = NULL; /* Check leading dimension(s) */ if( lda < n ) { info = -8; @@ -62,12 +60,23 @@ double LAPACKE_zlantr_work( int matrix_layout, char norm, char uplo, info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } + /* Allocate memory for work array(s) */ + if( LAPACKE_lsame( norm, 'i' ) ) { + work_lapack = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,m) ); + if( work_lapack == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_1; + } + } /* Transpose input matrices */ LAPACKE_ztr_trans( matrix_layout, uplo, diag, MAX(m,n), a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ - res = LAPACK_zlantr( &norm, &uplo, &diag, &m, &n, a_t, &lda_t, work ); - info = 0; /* LAPACK call is ok! */ + res = LAPACK_zlantr( &norm, &uplo, &diag, &m, &n, a_t, &lda_t, work_lapack ); /* Release memory and exit */ + if( work_lapack ) { + LAPACKE_free( work_lapack ); + } +exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { diff --git a/lapack-netlib/LAPACKE/src/lapacke_zstedc.c b/lapack-netlib/LAPACKE/src/lapacke_zstedc.c index 1bd7274c1..665c4414f 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_zstedc.c +++ b/lapack-netlib/LAPACKE/src/lapacke_zstedc.c @@ -74,7 +74,7 @@ lapack_int LAPACKE_zstedc( int matrix_layout, char compz, lapack_int n, if( info != 0 ) { goto exit_level_0; } - liwork = (lapack_int)iwork_query; + liwork = iwork_query; lrwork = (lapack_int)rwork_query; lwork = LAPACK_Z2INT( work_query ); /* Allocate memory for work arrays */ diff --git a/lapack-netlib/LAPACKE/src/lapacke_zstegr.c b/lapack-netlib/LAPACKE/src/lapacke_zstegr.c index 2a65dcc4d..07b5ce81d 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_zstegr.c +++ b/lapack-netlib/LAPACKE/src/lapacke_zstegr.c @@ -82,7 +82,7 @@ lapack_int LAPACKE_zstegr( int matrix_layout, char jobz, char range, if( info != 0 ) { goto exit_level_0; } - liwork = (lapack_int)iwork_query; + liwork = iwork_query; lwork = (lapack_int)work_query; /* Allocate memory for work arrays */ iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork ); diff --git a/lapack-netlib/LAPACKE/src/lapacke_zstemr.c b/lapack-netlib/LAPACKE/src/lapacke_zstemr.c index c1144488e..d1d1d5692 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_zstemr.c +++ b/lapack-netlib/LAPACKE/src/lapacke_zstemr.c @@ -75,7 +75,7 @@ lapack_int LAPACKE_zstemr( int matrix_layout, char jobz, char range, if( info != 0 ) { goto exit_level_0; } - liwork = (lapack_int)iwork_query; + liwork = iwork_query; lwork = (lapack_int)work_query; /* Allocate memory for work arrays */ iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork ); diff --git a/lapack-netlib/LAPACKE/src/lapacke_zsytrs2.c b/lapack-netlib/LAPACKE/src/lapacke_zsytrs2.c index 3c85f9796..7442702aa 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_zsytrs2.c +++ b/lapack-netlib/LAPACKE/src/lapacke_zsytrs2.c @@ -34,7 +34,7 @@ #include "lapacke_utils.h" lapack_int LAPACKE_zsytrs2( int matrix_layout, char uplo, lapack_int n, - lapack_int nrhs, const lapack_complex_double* a, + lapack_int nrhs, lapack_complex_double* a, lapack_int lda, const lapack_int* ipiv, lapack_complex_double* b, lapack_int ldb ) { diff --git a/lapack-netlib/LAPACKE/src/lapacke_zsytrs2_work.c b/lapack-netlib/LAPACKE/src/lapacke_zsytrs2_work.c index cdc97fa02..ec05ce6d5 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_zsytrs2_work.c +++ b/lapack-netlib/LAPACKE/src/lapacke_zsytrs2_work.c @@ -35,7 +35,7 @@ lapack_int LAPACKE_zsytrs2_work( int matrix_layout, char uplo, lapack_int n, lapack_int nrhs, - const lapack_complex_double* a, lapack_int lda, + lapack_complex_double* a, lapack_int lda, const lapack_int* ipiv, lapack_complex_double* b, lapack_int ldb, lapack_complex_double* work ) diff --git a/lapack-netlib/LAPACKE/src/lapacke_ztgsen.c b/lapack-netlib/LAPACKE/src/lapacke_ztgsen.c index 60f48ba8f..f6f58becd 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_ztgsen.c +++ b/lapack-netlib/LAPACKE/src/lapacke_ztgsen.c @@ -84,7 +84,7 @@ lapack_int LAPACKE_ztgsen( int matrix_layout, lapack_int ijob, if( info != 0 ) { goto exit_level_0; } - liwork = (lapack_int)iwork_query; + liwork = iwork_query; lwork = LAPACK_Z2INT( work_query ); /* Allocate memory for work arrays */ if( ijob != 0 ) { diff --git a/lapack-netlib/LAPACKE/src/lapacke_ztprfb.c b/lapack-netlib/LAPACKE/src/lapacke_ztprfb.c index fce801762..7a791c0d4 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_ztprfb.c +++ b/lapack-netlib/LAPACKE/src/lapacke_ztprfb.c @@ -41,7 +41,7 @@ lapack_int LAPACKE_ztprfb( int matrix_layout, char side, char trans, char direct lapack_complex_double* a, lapack_int lda, lapack_complex_double* b, lapack_int ldb) { - lapack_int ncols_v, nrows_v; + lapack_int ncols_v, nrows_v, ncols_a, nrows_a; lapack_int info = 0; lapack_int ldwork; lapack_int work_size; @@ -52,20 +52,33 @@ lapack_int LAPACKE_ztprfb( int matrix_layout, char side, char trans, char direct } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { - /* Optionally check input matrices for NaNs */ + /* Optionally check input matrices for NaNs + * V is m-by-k (left, columnwise) + * or n-by-k (right, columnwise) + * or k-by-m (left, rowwise) + * or k-by-n (right, rowwise) + * T is k-by-k + * A is k-by-n (left) + * or m-by-k (right) + * B is m-by-n + */ if( LAPACKE_lsame( storev, 'C' ) ) { ncols_v = k; nrows_v = LAPACKE_lsame( side, 'L' ) ? m : - ( LAPACKE_lsame( side, 'R' ) ? n : 0 ); + LAPACKE_lsame( side, 'R' ) ? n : 0; } else if( LAPACKE_lsame( storev, 'R' ) ) { ncols_v = LAPACKE_lsame( side, 'L' ) ? m : - ( LAPACKE_lsame( side, 'R' ) ? n : 0 ); + LAPACKE_lsame( side, 'R' ) ? n : 0; nrows_v = k; } else { ncols_v = 0; nrows_v = 0; } - if( LAPACKE_zge_nancheck( matrix_layout, k, m, a, lda ) ) { + nrows_a = LAPACKE_lsame( side, 'L' ) ? k : + LAPACKE_lsame( side, 'R' ) ? m : 0; + ncols_a = LAPACKE_lsame( side, 'L' ) ? n : + LAPACKE_lsame( side, 'R' ) ? k : 0; + if( LAPACKE_zge_nancheck( matrix_layout, ncols_a, nrows_a, a, lda ) ) { return -14; } if( LAPACKE_zge_nancheck( matrix_layout, m, n, b, ldb ) ) { @@ -80,17 +93,16 @@ lapack_int LAPACKE_ztprfb( int matrix_layout, char side, char trans, char direct } #endif if (side=='l' || side=='L') { - ldwork = k; - work_size = MAX(1,ldwork) * MAX(1,n); - } + ldwork = k; + work_size = MAX(1,ldwork) * MAX(1,n); + } else { - ldwork = m; - work_size = MAX(1,ldwork) * MAX(1,k); - } - + ldwork = m; + work_size = MAX(1,ldwork) * MAX(1,k); + } /* Allocate memory for working array(s) */ work = (lapack_complex_double*) - LAPACKE_malloc( sizeof(lapack_complex_double) * work_size ); + LAPACKE_malloc( sizeof(lapack_complex_double) * work_size ); if( work == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; goto exit_level_0; diff --git a/lapack-netlib/LAPACKE/src/lapacke_zunmhr.c b/lapack-netlib/LAPACKE/src/lapacke_zunmhr.c index 357d71184..61ed6f6f2 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_zunmhr.c +++ b/lapack-netlib/LAPACKE/src/lapacke_zunmhr.c @@ -58,7 +58,7 @@ lapack_int LAPACKE_zunmhr( int matrix_layout, char side, char trans, if( LAPACKE_zge_nancheck( matrix_layout, m, n, c, ldc ) ) { return -11; } - if( LAPACKE_z_nancheck( m-1, tau, 1 ) ) { + if( LAPACKE_z_nancheck( r-1, tau, 1 ) ) { return -10; } }