Skip to content

Commit c8ce9e4

Browse files
martin-frbgmartin-frbg
authored
Merge pull request #1101 from martin-frbg/martin-frbg-patch-1
LAPACKE: fix wrong number of columns in ?ormlq
2 parents 39eecfd + 3f7720e commit c8ce9e4

File tree

6 files changed

+26
-36
lines changed

6 files changed

+26
-36
lines changed

‎lapack-netlib/LAPACKE/src/lapacke_cunmlq_work.c

Lines changed: 4 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -42,9 +42,6 @@ lapack_int LAPACKE_cunmlq_work( int matrix_layout, char side, char trans,
4242
{
4343
lapack_int info = 0;
4444
lapack_int r;
45-
lapack_int lda_t, ldc_t;
46-
lapack_complex_float* a_t = NULL;
47-
lapack_complex_float* c_t = NULL;
4845
if( matrix_layout == LAPACK_COL_MAJOR ) {
4946
/* Call LAPACK function and adjust info */
5047
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,
5451
}
5552
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
5653
r = LAPACKE_lsame( side, 'l' ) ? m : n;
57-
lda_t = MAX(1,k);
58-
ldc_t = MAX(1,m);
54+
lapack_int lda_t = MAX(1,k);
55+
lapack_int ldc_t = MAX(1,m);
56+
lapack_complex_float* a_t = NULL;
57+
lapack_complex_float* c_t = NULL;
5958
/* Check leading dimension(s) */
6059
if( lda < r ) {
6160
info = -8;

‎lapack-netlib/LAPACKE/src/lapacke_dormlq.c

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -48,7 +48,8 @@ lapack_int LAPACKE_dormlq( int matrix_layout, char side, char trans,
4848
}
4949
#ifndef LAPACK_DISABLE_NAN_CHECK
5050
/* Optionally check input matrices for NaNs */
51-
if( LAPACKE_dge_nancheck( matrix_layout, k, m, a, lda ) ) {
51+
lapack_int r = LAPACKE_lsame( side, 'l' ) ? m : n;
52+
if( LAPACKE_dge_nancheck( matrix_layout, k, r, a, lda ) ) {
5253
return -7;
5354
}
5455
if( LAPACKE_dge_nancheck( matrix_layout, m, n, c, ldc ) ) {

‎lapack-netlib/LAPACKE/src/lapacke_dormlq_work.c

Lines changed: 7 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -40,9 +40,6 @@ lapack_int LAPACKE_dormlq_work( int matrix_layout, char side, char trans,
4040
double* work, lapack_int lwork )
4141
{
4242
lapack_int info = 0;
43-
lapack_int r;
44-
lapack_int lda_t, ldc_t;
45-
double *a_t = NULL, *c_t = NULL;
4643
if( matrix_layout == LAPACK_COL_MAJOR ) {
4744
/* Call LAPACK function and adjust info */
4845
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,
5148
info = info - 1;
5249
}
5350
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
54-
r = LAPACKE_lsame( side, 'l' ) ? m : n;
55-
lda_t = MAX(1,k);
56-
ldc_t = MAX(1,m);
51+
lapack_int r = LAPACKE_lsame( side, 'l' ) ? m : n;
52+
lapack_int lda_t = MAX(1,k);
53+
lapack_int ldc_t = MAX(1,m);
54+
double *a_t = NULL;
55+
double *c_t = NULL;
5756
/* Check leading dimension(s) */
5857
if( lda < r ) {
5958
info = -8;
@@ -72,11 +71,7 @@ lapack_int LAPACKE_dormlq_work( int matrix_layout, char side, char trans,
7271
return (info < 0) ? (info - 1) : info;
7372
}
7473
/* Allocate memory for temporary array(s) */
75-
if( LAPACKE_lsame( side, 'l' ) ) {
76-
a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,m) );
77-
} else {
78-
a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
79-
}
74+
a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,r) );
8075
if( a_t == NULL ) {
8176
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
8277
goto exit_level_0;
@@ -87,7 +82,7 @@ lapack_int LAPACKE_dormlq_work( int matrix_layout, char side, char trans,
8782
goto exit_level_1;
8883
}
8984
/* Transpose input matrices */
90-
LAPACKE_dge_trans( matrix_layout, k, m, a, lda, a_t, lda_t );
85+
LAPACKE_dge_trans( matrix_layout, k, r, a, lda, a_t, lda_t );
9186
LAPACKE_dge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t );
9287
/* Call LAPACK function and adjust info */
9388
LAPACK_dormlq( &side, &trans, &m, &n, &k, a_t, &lda_t, tau, c_t, &ldc_t,

‎lapack-netlib/LAPACKE/src/lapacke_sormlq.c

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -48,7 +48,8 @@ lapack_int LAPACKE_sormlq( int matrix_layout, char side, char trans,
4848
}
4949
#ifndef LAPACK_DISABLE_NAN_CHECK
5050
/* Optionally check input matrices for NaNs */
51-
if( LAPACKE_sge_nancheck( matrix_layout, k, m, a, lda ) ) {
51+
lapack_int r = LAPACKE_lsame( side, 'l' ) ? m : n;
52+
if( LAPACKE_sge_nancheck( matrix_layout, k, r, a, lda ) ) {
5253
return -7;
5354
}
5455
if( LAPACKE_sge_nancheck( matrix_layout, m, n, c, ldc ) ) {

‎lapack-netlib/LAPACKE/src/lapacke_sormlq_work.c

Lines changed: 7 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -40,9 +40,6 @@ lapack_int LAPACKE_sormlq_work( int matrix_layout, char side, char trans,
4040
float* work, lapack_int lwork )
4141
{
4242
lapack_int info = 0;
43-
lapack_int r;
44-
lapack_int lda_t, ldc_t;
45-
float *a_t = NULL, *c_t = NULL;
4643
if( matrix_layout == LAPACK_COL_MAJOR ) {
4744
/* Call LAPACK function and adjust info */
4845
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,
5148
info = info - 1;
5249
}
5350
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
54-
r = LAPACKE_lsame( side, 'l' ) ? m : n;
55-
lda_t = MAX(1,k);
56-
ldc_t = MAX(1,m);
51+
lapack_int r = LAPACKE_lsame( side, 'l' ) ? m : n;
52+
lapack_int lda_t = MAX(1,k);
53+
lapack_int ldc_t = MAX(1,m);
54+
float *a_t = NULL;
55+
float *c_t = NULL;
5756
/* Check leading dimension(s) */
5857
if( lda < r ) {
5958
info = -8;
@@ -72,11 +71,7 @@ lapack_int LAPACKE_sormlq_work( int matrix_layout, char side, char trans,
7271
return (info < 0) ? (info - 1) : info;
7372
}
7473
/* Allocate memory for temporary array(s) */
75-
if( LAPACKE_lsame( side, 'l' ) ) {
76-
a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,m) );
77-
} else {
78-
a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
79-
}
74+
a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,r) );
8075
if( a_t == NULL ) {
8176
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
8277
goto exit_level_0;
@@ -87,7 +82,7 @@ lapack_int LAPACKE_sormlq_work( int matrix_layout, char side, char trans,
8782
goto exit_level_1;
8883
}
8984
/* Transpose input matrices */
90-
LAPACKE_sge_trans( matrix_layout, k, m, a, lda, a_t, lda_t );
85+
LAPACKE_sge_trans( matrix_layout, k, r, a, lda, a_t, lda_t );
9186
LAPACKE_sge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t );
9287
/* Call LAPACK function and adjust info */
9388
LAPACK_sormlq( &side, &trans, &m, &n, &k, a_t, &lda_t, tau, c_t, &ldc_t,

‎lapack-netlib/LAPACKE/src/lapacke_zunmlq_work.c

Lines changed: 4 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -42,9 +42,6 @@ lapack_int LAPACKE_zunmlq_work( int matrix_layout, char side, char trans,
4242
{
4343
lapack_int info = 0;
4444
lapack_int r;
45-
lapack_int lda_t, ldc_t;
46-
lapack_complex_double* a_t = NULL;
47-
lapack_complex_double* c_t = NULL;
4845
if( matrix_layout == LAPACK_COL_MAJOR ) {
4946
/* Call LAPACK function and adjust info */
5047
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,
5451
}
5552
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
5653
r = LAPACKE_lsame( side, 'l' ) ? m : n;
57-
lda_t = MAX(1,k);
58-
ldc_t = MAX(1,m);
54+
lapack_int lda_t = MAX(1,k);
55+
lapack_int ldc_t = MAX(1,m);
56+
lapack_complex_double* a_t = NULL;
57+
lapack_complex_double* c_t = NULL;
5958
/* Check leading dimension(s) */
6059
if( lda < r ) {
6160
info = -8;

0 commit comments

Comments
 (0)