Merge pull request #1101 from martin-frbg/martin-frbg-patch-1

LAPACKE: fix wrong number of columns in ?ormlq

lapack-netlib/LAPACKE/src/lapacke_cunmlq_work.c

@@ -42,9 +42,6 @@ lapack_int LAPACKE_cunmlq_work( int matrix_layout, char side, char trans,
 {
     lapack_int info = 0;
     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 ) {
         /* Call LAPACK function and adjust info */
         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 ) {
         r = LAPACKE_lsame( side, 'l' ) ? m : n;
-        lda_t = MAX(1,k);
-        ldc_t = MAX(1,m);
+        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 < r ) {
             info = -8;

lapack-netlib/LAPACKE/src/lapacke_dormlq.c

@@ -48,7 +48,8 @@ lapack_int LAPACKE_dormlq( int matrix_layout, char side, char trans,
     }
 #ifndef LAPACK_DISABLE_NAN_CHECK
     /* 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;
     }
     if( LAPACKE_dge_nancheck( matrix_layout, m, n, c, ldc ) ) {

lapack-netlib/LAPACKE/src/lapacke_dormlq_work.c

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

lapack-netlib/LAPACKE/src/lapacke_sormlq.c

@@ -48,7 +48,8 @@ lapack_int LAPACKE_sormlq( int matrix_layout, char side, char trans,
     }
 #ifndef LAPACK_DISABLE_NAN_CHECK
     /* 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;
     }
     if( LAPACKE_sge_nancheck( matrix_layout, m, n, c, ldc ) ) {

lapack-netlib/LAPACKE/src/lapacke_sormlq_work.c

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

lapack-netlib/LAPACKE/src/lapacke_zunmlq_work.c

@@ -42,9 +42,6 @@ lapack_int LAPACKE_zunmlq_work( int matrix_layout, char side, char trans,
 {
     lapack_int info = 0;
     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 ) {
         /* Call LAPACK function and adjust info */
         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 ) {
         r = LAPACKE_lsame( side, 'l' ) ? m : n;
-        lda_t = MAX(1,k);
-        ldc_t = MAX(1,m);
+        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 < r ) {
             info = -8;