Fixing bug 133
authorjulie <julielangou@users.noreply.github.com>
Thu, 3 Sep 2015 06:07:59 +0000 (06:07 +0000)
committerjulie <julielangou@users.noreply.github.com>
Thu, 3 Sep 2015 06:07:59 +0000 (06:07 +0000)
Bug reported by the GONUM team member: btracey on LAPACK forum
Link: http://icl.cs.utk.edu/lapack-forum/viewtopic.php?f=13&t=4771
Description:  the number of columns of A depends on the Side, so the test should compare against m or n.

Fix by Julie.

LAPACKE/src/lapacke_cunmlq_work.c
LAPACKE/src/lapacke_dormlq_work.c
LAPACKE/src/lapacke_sormlq_work.c
LAPACKE/src/lapacke_zunmlq_work.c

index e8fcf23..5cf6642 100644 (file)
@@ -41,6 +41,7 @@ lapack_int LAPACKE_cunmlq_work( int matrix_layout, char side, char trans,
                                 lapack_complex_float* work, lapack_int lwork )
 {
     lapack_int info = 0;
+    lapack_int r;
     if( matrix_layout == LAPACK_COL_MAJOR ) {
         /* Call LAPACK function and adjust info */
         LAPACK_cunmlq( &side, &trans, &m, &n, &k, a, &lda, tau, c, &ldc, work,
@@ -49,12 +50,13 @@ lapack_int LAPACKE_cunmlq_work( int matrix_layout, char side, char trans,
             info = info - 1;
         }
     } else if( matrix_layout == LAPACK_ROW_MAJOR ) {
+        r = LAPACKE_lsame( side, 'l' ) ? m : n;
         lapack_int lda_t = MAX(1,k);
         lapack_int ldc_t = MAX(1,m);
         lapack_complex_float* a_t = NULL;
         lapack_complex_float* c_t = NULL;
         /* Check leading dimension(s) */
-        if( lda < m ) {
+        if( lda < r ) {
             info = -8;
             LAPACKE_xerbla( "LAPACKE_cunmlq_work", info );
             return info;
index 5a1a647..99a7c3c 100644 (file)
@@ -40,6 +40,7 @@ lapack_int LAPACKE_dormlq_work( int matrix_layout, char side, char trans,
                                 double* work, lapack_int lwork )
 {
     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 ) {
@@ -50,10 +51,11 @@ lapack_int LAPACKE_dormlq_work( int matrix_layout, char side, char trans,
             info = info - 1;
         }
     } else if( matrix_layout == LAPACK_ROW_MAJOR ) {
+        r = LAPACKE_lsame( side, 'l' ) ? m : n;
         lda_t = MAX(1,k);
         ldc_t = MAX(1,m);
         /* Check leading dimension(s) */
-        if( lda < m ) {
+        if( lda < r ) {
             info = -8;
             LAPACKE_xerbla( "LAPACKE_dormlq_work", info );
             return info;
index 9934f02..bbf55bd 100644 (file)
@@ -40,6 +40,7 @@ lapack_int LAPACKE_sormlq_work( int matrix_layout, char side, char trans,
                                 float* work, lapack_int lwork )
 {
     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 ) {
@@ -50,10 +51,11 @@ lapack_int LAPACKE_sormlq_work( int matrix_layout, char side, char trans,
             info = info - 1;
         }
     } else if( matrix_layout == LAPACK_ROW_MAJOR ) {
+        r = LAPACKE_lsame( side, 'l' ) ? m : n;
         lda_t = MAX(1,k);
         ldc_t = MAX(1,m);
         /* Check leading dimension(s) */
-        if( lda < m ) {
+        if( lda < r ) {
             info = -8;
             LAPACKE_xerbla( "LAPACKE_sormlq_work", info );
             return info;
index 7390ca9..38a2d94 100644 (file)
@@ -41,6 +41,7 @@ lapack_int LAPACKE_zunmlq_work( int matrix_layout, char side, char trans,
                                 lapack_complex_double* work, lapack_int lwork )
 {
     lapack_int info = 0;
+    lapack_int r;
     if( matrix_layout == LAPACK_COL_MAJOR ) {
         /* Call LAPACK function and adjust info */
         LAPACK_zunmlq( &side, &trans, &m, &n, &k, a, &lda, tau, c, &ldc, work,
@@ -49,12 +50,13 @@ lapack_int LAPACKE_zunmlq_work( int matrix_layout, char side, char trans,
             info = info - 1;
         }
     } else if( matrix_layout == LAPACK_ROW_MAJOR ) {
+        r = LAPACKE_lsame( side, 'l' ) ? m : n;
         lapack_int lda_t = MAX(1,k);
         lapack_int ldc_t = MAX(1,m);
         lapack_complex_double* a_t = NULL;
         lapack_complex_double* c_t = NULL;
         /* Check leading dimension(s) */
-        if( lda < m ) {
+        if( lda < r ) {
             info = -8;
             LAPACKE_xerbla( "LAPACKE_zunmlq_work", info );
             return info;