floraachy
/
OpenBLAS
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

LAPACKE: fix wrong number of columns in ?ormlq 

Copied from lapack https://github.com/Reference-LAPACK/lapack/pull/127  by vladimir-ch (with earlier changes from echeresh's  
PR 115 "lapacke_*ormlq_work: move declarations under if" there as they touched some of the same files)
This commit is contained in:
Martin Kroeker 2017-02-20 16:20:43 +01:00 committed by GitHub
parent e545a66a5b
commit 3f7720ec4b
6 changed files with 26 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
lapack-netlib/LAPACKE/src/lapacke_cunmlq_work.c
View File

@ -42,9 +42,6 @@ lapack_int LAPACKE_cunmlq_work( int matrix_layout, char side, char trans,
{ {
lapack_int info = 0; lapack_int info = 0;
lapack_int r; lapack_int r;
lapack_int lda_t, ldc_t;
lapack_complex_float* a_t = NULL;
lapack_complex_float* c_t = NULL;
if( matrix_layout == LAPACK_COL_MAJOR ) { if( matrix_layout == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */ /* Call LAPACK function and adjust info */
LAPACK_cunmlq( &side, &trans, &m, &n, &k, a, &lda, tau, c, &ldc, work, LAPACK_cunmlq( &side, &trans, &m, &n, &k, a, &lda, tau, c, &ldc, work,
@ -54,8 +51,10 @@ lapack_int LAPACKE_cunmlq_work( int matrix_layout, char side, char trans,
} }
} else if( matrix_layout == LAPACK_ROW_MAJOR ) { } else if( matrix_layout == LAPACK_ROW_MAJOR ) {
r = LAPACKE_lsame( side, 'l' ) ? m : n; r = LAPACKE_lsame( side, 'l' ) ? m : n;
lda_t = MAX(1,k); lapack_int lda_t = MAX(1,k);
ldc_t = MAX(1,m); lapack_int ldc_t = MAX(1,m);
lapack_complex_float* a_t = NULL;
lapack_complex_float* c_t = NULL;
/* Check leading dimension(s) */ /* Check leading dimension(s) */
if( lda < r ) { if( lda < r ) {
info = -8; info = -8;

3
lapack-netlib/LAPACKE/src/lapacke_dormlq.c
View File

@ -48,7 +48,8 @@ lapack_int LAPACKE_dormlq( int matrix_layout, char side, char trans,
} }
#ifndef LAPACK_DISABLE_NAN_CHECK #ifndef LAPACK_DISABLE_NAN_CHECK
/* Optionally check input matrices for NaNs */ /* Optionally check input matrices for NaNs */
if( LAPACKE_dge_nancheck( matrix_layout, k, m, a, lda ) ) { lapack_int r = LAPACKE_lsame( side, 'l' ) ? m : n;
if( LAPACKE_dge_nancheck( matrix_layout, k, r, a, lda ) ) {
return -7; return -7;
} }
if( LAPACKE_dge_nancheck( matrix_layout, m, n, c, ldc ) ) { if( LAPACKE_dge_nancheck( matrix_layout, m, n, c, ldc ) ) {

19
lapack-netlib/LAPACKE/src/lapacke_dormlq_work.c
View File

@ -40,9 +40,6 @@ lapack_int LAPACKE_dormlq_work( int matrix_layout, char side, char trans,
double* work, lapack_int lwork ) double* work, lapack_int lwork )
{ {
lapack_int info = 0; lapack_int info = 0;
lapack_int r;
lapack_int lda_t, ldc_t;
double *a_t = NULL, *c_t = NULL;
if( matrix_layout == LAPACK_COL_MAJOR ) { if( matrix_layout == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */ /* Call LAPACK function and adjust info */
LAPACK_dormlq( &side, &trans, &m, &n, &k, a, &lda, tau, c, &ldc, work, LAPACK_dormlq( &side, &trans, &m, &n, &k, a, &lda, tau, c, &ldc, work,
@ -51,9 +48,11 @@ lapack_int LAPACKE_dormlq_work( int matrix_layout, char side, char trans,
info = info - 1; info = info - 1;
} }
} else if( matrix_layout == LAPACK_ROW_MAJOR ) { } else if( matrix_layout == LAPACK_ROW_MAJOR ) {
r = LAPACKE_lsame( side, 'l' ) ? m : n; lapack_int r = LAPACKE_lsame( side, 'l' ) ? m : n;
lda_t = MAX(1,k); lapack_int lda_t = MAX(1,k);
ldc_t = MAX(1,m); lapack_int ldc_t = MAX(1,m);
double *a_t = NULL;
double *c_t = NULL;
/* Check leading dimension(s) */ /* Check leading dimension(s) */
if( lda < r ) { if( lda < r ) {
info = -8; info = -8;
@ -72,11 +71,7 @@ lapack_int LAPACKE_dormlq_work( int matrix_layout, char side, char trans,
return (info < 0) ? (info - 1) : info; return (info < 0) ? (info - 1) : info;
} }
/* Allocate memory for temporary array(s) */ /* Allocate memory for temporary array(s) */
if( LAPACKE_lsame( side, 'l' ) ) { a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,r) );
a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,m) );
} else {
a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
}
if( a_t == NULL ) { if( a_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR; info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_0; goto exit_level_0;
@ -87,7 +82,7 @@ lapack_int LAPACKE_dormlq_work( int matrix_layout, char side, char trans,
goto exit_level_1; goto exit_level_1;
} }
/* Transpose input matrices */ /* Transpose input matrices */
LAPACKE_dge_trans( matrix_layout, k, m, a, lda, a_t, lda_t ); LAPACKE_dge_trans( matrix_layout, k, r, a, lda, a_t, lda_t );
LAPACKE_dge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t ); LAPACKE_dge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t );
/* Call LAPACK function and adjust info */ /* Call LAPACK function and adjust info */
LAPACK_dormlq( &side, &trans, &m, &n, &k, a_t, &lda_t, tau, c_t, &ldc_t, LAPACK_dormlq( &side, &trans, &m, &n, &k, a_t, &lda_t, tau, c_t, &ldc_t,

3
lapack-netlib/LAPACKE/src/lapacke_sormlq.c
View File

@ -48,7 +48,8 @@ lapack_int LAPACKE_sormlq( int matrix_layout, char side, char trans,
} }
#ifndef LAPACK_DISABLE_NAN_CHECK #ifndef LAPACK_DISABLE_NAN_CHECK
/* Optionally check input matrices for NaNs */ /* Optionally check input matrices for NaNs */
if( LAPACKE_sge_nancheck( matrix_layout, k, m, a, lda ) ) { lapack_int r = LAPACKE_lsame( side, 'l' ) ? m : n;
if( LAPACKE_sge_nancheck( matrix_layout, k, r, a, lda ) ) {
return -7; return -7;
} }
if( LAPACKE_sge_nancheck( matrix_layout, m, n, c, ldc ) ) { if( LAPACKE_sge_nancheck( matrix_layout, m, n, c, ldc ) ) {

19
lapack-netlib/LAPACKE/src/lapacke_sormlq_work.c
View File

@ -40,9 +40,6 @@ lapack_int LAPACKE_sormlq_work( int matrix_layout, char side, char trans,
float* work, lapack_int lwork ) float* work, lapack_int lwork )
{ {
lapack_int info = 0; lapack_int info = 0;
lapack_int r;
lapack_int lda_t, ldc_t;
float *a_t = NULL, *c_t = NULL;
if( matrix_layout == LAPACK_COL_MAJOR ) { if( matrix_layout == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */ /* Call LAPACK function and adjust info */
LAPACK_sormlq( &side, &trans, &m, &n, &k, a, &lda, tau, c, &ldc, work, LAPACK_sormlq( &side, &trans, &m, &n, &k, a, &lda, tau, c, &ldc, work,
@ -51,9 +48,11 @@ lapack_int LAPACKE_sormlq_work( int matrix_layout, char side, char trans,
info = info - 1; info = info - 1;
} }
} else if( matrix_layout == LAPACK_ROW_MAJOR ) { } else if( matrix_layout == LAPACK_ROW_MAJOR ) {
r = LAPACKE_lsame( side, 'l' ) ? m : n; lapack_int r = LAPACKE_lsame( side, 'l' ) ? m : n;
lda_t = MAX(1,k); lapack_int lda_t = MAX(1,k);
ldc_t = MAX(1,m); lapack_int ldc_t = MAX(1,m);
float *a_t = NULL;
float *c_t = NULL;
/* Check leading dimension(s) */ /* Check leading dimension(s) */
if( lda < r ) { if( lda < r ) {
info = -8; info = -8;
@ -72,11 +71,7 @@ lapack_int LAPACKE_sormlq_work( int matrix_layout, char side, char trans,
return (info < 0) ? (info - 1) : info; return (info < 0) ? (info - 1) : info;
} }
/* Allocate memory for temporary array(s) */ /* Allocate memory for temporary array(s) */
if( LAPACKE_lsame( side, 'l' ) ) { a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,r) );
a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,m) );
} else {
a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
}
if( a_t == NULL ) { if( a_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR; info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_0; goto exit_level_0;
@ -87,7 +82,7 @@ lapack_int LAPACKE_sormlq_work( int matrix_layout, char side, char trans,
goto exit_level_1; goto exit_level_1;
} }
/* Transpose input matrices */ /* Transpose input matrices */
LAPACKE_sge_trans( matrix_layout, k, m, a, lda, a_t, lda_t ); LAPACKE_sge_trans( matrix_layout, k, r, a, lda, a_t, lda_t );
LAPACKE_sge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t ); LAPACKE_sge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t );
/* Call LAPACK function and adjust info */ /* Call LAPACK function and adjust info */
LAPACK_sormlq( &side, &trans, &m, &n, &k, a_t, &lda_t, tau, c_t, &ldc_t, LAPACK_sormlq( &side, &trans, &m, &n, &k, a_t, &lda_t, tau, c_t, &ldc_t,

9
lapack-netlib/LAPACKE/src/lapacke_zunmlq_work.c
View File

@ -42,9 +42,6 @@ lapack_int LAPACKE_zunmlq_work( int matrix_layout, char side, char trans,
{ {
lapack_int info = 0; lapack_int info = 0;
lapack_int r; lapack_int r;
lapack_int lda_t, ldc_t;
lapack_complex_double* a_t = NULL;
lapack_complex_double* c_t = NULL;
if( matrix_layout == LAPACK_COL_MAJOR ) { if( matrix_layout == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */ /* Call LAPACK function and adjust info */
LAPACK_zunmlq( &side, &trans, &m, &n, &k, a, &lda, tau, c, &ldc, work, LAPACK_zunmlq( &side, &trans, &m, &n, &k, a, &lda, tau, c, &ldc, work,
@ -54,8 +51,10 @@ lapack_int LAPACKE_zunmlq_work( int matrix_layout, char side, char trans,
} }
} else if( matrix_layout == LAPACK_ROW_MAJOR ) { } else if( matrix_layout == LAPACK_ROW_MAJOR ) {
r = LAPACKE_lsame( side, 'l' ) ? m : n; r = LAPACKE_lsame( side, 'l' ) ? m : n;
lda_t = MAX(1,k); lapack_int lda_t = MAX(1,k);
ldc_t = MAX(1,m); lapack_int ldc_t = MAX(1,m);
lapack_complex_double* a_t = NULL;
lapack_complex_double* c_t = NULL;
/* Check leading dimension(s) */ /* Check leading dimension(s) */
if( lda < r ) { if( lda < r ) {
info = -8; info = -8;