APPLYING INTEL PATCHES sent to Julie on Feb 19th 2016 by Dima from INTEL (dmitry...

[PATCH 30/42] Fix lapacke_?lascl - bugs and NaN checks

- nancheck content, not padding (e.g. M-by-N, not LDA-by-N)
- types L, U: use ?gb_nancheck(m,n), not ?tr_nancheck(n)
- type H: use ?gb_nancheck(m,n), not ?hs_nancheck(n)
- type Z: use ?gb_nancheck correctly, do not check unset data
- type Z: M-by-N should be checked
- type Z: A is 9th parameter
- nrows_a is needed for correct transposition
- info from LAPACK should be respected

diff --git a/LAPACKE/src/lapacke_clascl.c b/LAPACKE/src/lapacke_clascl.c
index c21ec3e..63e5e75 100644 (file)
--- a/LAPACKE/src/lapacke_clascl.c
+++ b/LAPACKE/src/lapacke_clascl.c
@@ -46,50 +46,64 @@ lapack_int LAPACKE_clascl( int matrix_layout, char type, lapack_int kl,
     /* Optionally check input matrices for NaNs */
     switch (type) {
     case 'G':
-       if( LAPACKE_cge_nancheck( matrix_layout, lda, n, a, lda ) ) {
-           return -9;
-           }
+        if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
+            return -9;
+        }
         break;
     case 'L':
-       // TYPE = 'L' - lower triangular matrix.
-       if( LAPACKE_ctr_nancheck( matrix_layout, 'L', 'N', n, a, lda ) ) {
-           return -9;
-          }
+        // TYPE = 'L' - lower triangle of general matrix
+        if( matrix_layout == LAPACK_COL_MAJOR &&
+            LAPACKE_cgb_nancheck( matrix_layout, m, n, m-1, 0, a, lda+1 ) ) {
+            return -9;
+        }
+        if( matrix_layout == LAPACK_ROW_MAJOR &&
+            LAPACKE_cgb_nancheck( LAPACK_COL_MAJOR, n, m, 0, m-1, a-m+1, lda+1 ) ) {
+            return -9;
+        }
         break;
     case 'U':
-       // TYPE = 'U' - upper triangular matrix
-       if( LAPACKE_ctr_nancheck( matrix_layout, 'U', 'N', n, a, lda ) ) {
-           return -9;
-           } 
+        // TYPE = 'U' - upper triangle of general matrix
+        if( matrix_layout == LAPACK_COL_MAJOR &&
+            LAPACKE_cgb_nancheck( matrix_layout, m, n, 0, n-1, a-n+1, lda+1 ) ) {
+            return -9;
+        }
+        if( matrix_layout == LAPACK_ROW_MAJOR &&
+            LAPACKE_cgb_nancheck( LAPACK_COL_MAJOR, n, m, n-1, 0, a, lda+1 ) ) {
+            return -9;
+        }
         break;
     case 'H':
-       // TYPE = 'H' - upper Hessenberg matrix   
-       if( LAPACKE_chs_nancheck( matrix_layout, n, a, lda ) ) {
-           return -9;
-           }    
-        break;
+        // TYPE = 'H' - part of upper Hessenberg matrix in general matrix
+        if( matrix_layout == LAPACK_COL_MAJOR &&
+            LAPACKE_cgb_nancheck( matrix_layout, m, n, 1, n-1, a-n+1, lda+1 ) ) {
+            return -9;
+        }
+        if( matrix_layout == LAPACK_ROW_MAJOR &&
+            LAPACKE_cgb_nancheck( LAPACK_COL_MAJOR, n, m, n-1, 1, a-1, lda+1 ) ) {
+            return -9;
+        }
     case 'B':
-       // TYPE = 'B' - A is a symmetric band matrix with lower bandwidth KL
-       //             and upper bandwidth KU and with the only the lower
-       //             half stored.   
-       if( LAPACKE_chb_nancheck( matrix_layout, 'L', n, kl, a, lda ) ) {
-           return -9;
-           }
-         break;
-   case 'Q':
-       // TYPE = 'Q' - A is a symmetric band matrix with lower bandwidth KL
-       //             and upper bandwidth KU and with the only the upper
-       //             half stored.   
-       if( LAPACKE_chb_nancheck( matrix_layout, 'U', n, ku, a, lda ) ) {
-           return -9;
-           }
+        // TYPE = 'B' - lower part of symmetric band matrix (assume m==n)
+        if( LAPACKE_chb_nancheck( matrix_layout, 'L', n, kl, a, lda ) ) {
+            return -9;
+        }
+        break;
+    case 'Q':
+        // TYPE = 'Q' - upper part of symmetric band matrix (assume m==n)
+        if( LAPACKE_chb_nancheck( matrix_layout, 'U', n, ku, a, lda ) ) {
+            return -9;
+        }
         break;
     case 'Z':
-       // TYPE = 'Z' -  A is a band matrix with lower bandwidth KL and upper
-       //             bandwidth KU. See DGBTRF for storage details.        
-       if( LAPACKE_cgb_nancheck( matrix_layout, n, n, kl, kl+ku, a, lda ) ) {
-           return -6;
-           }
+        // TYPE = 'Z' -  band matrix laid out for ?GBTRF
+        if( matrix_layout == LAPACK_COL_MAJOR &&
+            LAPACKE_cgb_nancheck( matrix_layout, m, n, kl, ku, a+kl, lda ) ) {
+            return -9;
+        }
+        if( matrix_layout == LAPACK_ROW_MAJOR &&
+            LAPACKE_cgb_nancheck( matrix_layout, m, n, kl, ku, a+lda*kl, lda ) ) {
+            return -9;
+        }
         break;
     }
 #endif

diff --git a/LAPACKE/src/lapacke_clascl_work.c b/LAPACKE/src/lapacke_clascl_work.c
index 18ac1ef..0fdfc1d 100644 (file)
--- a/LAPACKE/src/lapacke_clascl_work.c
+++ b/LAPACKE/src/lapacke_clascl_work.c
@@ -46,7 +46,10 @@ lapack_int LAPACKE_clascl_work( int matrix_layout, char type, lapack_int kl,
             info = info - 1;
         }
     } else if( matrix_layout == LAPACK_ROW_MAJOR ) {
-        lapack_int lda_t = MAX(1,lda);
+        lapack_int nrows_a = LAPACKE_lsame(type, 'b') ? kl + 1 :
+                             LAPACKE_lsame(type, 'q') ? ku + 1 :
+                             LAPACKE_lsame(type, 'z') ? 2 * kl + ku + 1 : m;
+        lapack_int lda_t = MAX(1,nrows_a);
         lapack_complex_float* a_t = NULL;
         /* Check leading dimension(s) */
         if( lda < n ) {
@@ -62,12 +65,14 @@ lapack_int LAPACKE_clascl_work( int matrix_layout, char type, lapack_int kl,
             goto exit_level_0;
         }
         /* Transpose input matrices */
-        LAPACKE_cge_trans( matrix_layout, lda, n, a, lda, a_t, lda_t );
+        LAPACKE_cge_trans( matrix_layout, nrows_a, n, a, lda, a_t, lda_t );
         /* Call LAPACK function and adjust info */
         LAPACK_clascl( &type, &kl, &ku, &cfrom, &cto, &m, &n, a_t, &lda_t, &info);
-        info = 0;  /* LAPACK call is ok! */
+        if( info < 0 ) {
+            info = info - 1;
+        }
         /* Transpose output matrices */
-        LAPACKE_cge_trans( LAPACK_COL_MAJOR, lda, n, a_t, lda_t, a, lda );
+        LAPACKE_cge_trans( LAPACK_COL_MAJOR, nrows_a, n, a_t, lda_t, a, lda );
         /* Release memory and exit */
         LAPACKE_free( a_t );
 exit_level_0:

diff --git a/LAPACKE/src/lapacke_dlascl.c b/LAPACKE/src/lapacke_dlascl.c
index d3a2f49..a237035 100644 (file)
--- a/LAPACKE/src/lapacke_dlascl.c
+++ b/LAPACKE/src/lapacke_dlascl.c
@@ -46,50 +46,64 @@ lapack_int LAPACKE_dlascl( int matrix_layout, char type, lapack_int kl,
     /* Optionally check input matrices for NaNs */
     switch (type) {
     case 'G':
-       if( LAPACKE_dge_nancheck( matrix_layout, lda, n, a, lda ) ) {
-           return -9;
-           }
+        if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
+            return -9;
+        }
         break;
     case 'L':
-       // TYPE = 'L' - lower triangular matrix.
-       if( LAPACKE_dtr_nancheck( matrix_layout, 'L', 'N', n, a, lda ) ) {
-           return -9;
-          }
+        // TYPE = 'L' - lower triangle of general matrix
+        if( matrix_layout == LAPACK_COL_MAJOR &&
+            LAPACKE_dgb_nancheck( matrix_layout, m, n, m-1, 0, a, lda+1 ) ) {
+            return -9;
+        }
+        if( matrix_layout == LAPACK_ROW_MAJOR &&
+            LAPACKE_dgb_nancheck( LAPACK_COL_MAJOR, n, m, 0, m-1, a-m+1, lda+1 ) ) {
+            return -9;
+        }
         break;
     case 'U':
-       // TYPE = 'U' - upper triangular matrix
-       if( LAPACKE_dtr_nancheck( matrix_layout, 'U', 'N', n, a, lda ) ) {
-           return -9;
-           } 
+        // TYPE = 'U' - upper triangle of general matrix
+        if( matrix_layout == LAPACK_COL_MAJOR &&
+            LAPACKE_dgb_nancheck( matrix_layout, m, n, 0, n-1, a-n+1, lda+1 ) ) {
+            return -9;
+        }
+        if( matrix_layout == LAPACK_ROW_MAJOR &&
+            LAPACKE_dgb_nancheck( LAPACK_COL_MAJOR, n, m, n-1, 0, a, lda+1 ) ) {
+            return -9;
+        }
         break;
     case 'H':
-       // TYPE = 'H' - upper Hessenberg matrix   
-       if( LAPACKE_dhs_nancheck( matrix_layout, n, a, lda ) ) {
-           return -9;
-           }    
-        break;
+        // TYPE = 'H' - part of upper Hessenberg matrix in general matrix
+        if( matrix_layout == LAPACK_COL_MAJOR &&
+            LAPACKE_dgb_nancheck( matrix_layout, m, n, 1, n-1, a-n+1, lda+1 ) ) {
+            return -9;
+        }
+        if( matrix_layout == LAPACK_ROW_MAJOR &&
+            LAPACKE_dgb_nancheck( LAPACK_COL_MAJOR, n, m, n-1, 1, a-1, lda+1 ) ) {
+            return -9;
+        }
     case 'B':
-       // TYPE = 'B' - A is a symmetric band matrix with lower bandwidth KL
-       //             and upper bandwidth KU and with the only the lower
-       //             half stored.   
-       if( LAPACKE_dsb_nancheck( matrix_layout, 'L', n, kl, a, lda ) ) {
-           return -9;
-           }
-         break;
-   case 'Q':
-       // TYPE = 'Q' - A is a symmetric band matrix with lower bandwidth KL
-       //             and upper bandwidth KU and with the only the upper
-       //             half stored.   
-       if( LAPACKE_dsb_nancheck( matrix_layout, 'U', n, ku, a, lda ) ) {
-           return -9;
-           }
+        // TYPE = 'B' - lower part of symmetric band matrix (assume m==n)
+        if( LAPACKE_dsb_nancheck( matrix_layout, 'L', n, kl, a, lda ) ) {
+            return -9;
+        }
+        break;
+    case 'Q':
+        // TYPE = 'Q' - upper part of symmetric band matrix (assume m==n)
+        if( LAPACKE_dsb_nancheck( matrix_layout, 'U', n, ku, a, lda ) ) {
+            return -9;
+        }
         break;
     case 'Z':
-       // TYPE = 'Z' -  A is a band matrix with lower bandwidth KL and upper
-       //             bandwidth KU. See DGBTRF for storage details.        
-       if( LAPACKE_dgb_nancheck( matrix_layout, n, n, kl, kl+ku, a, lda ) ) {
-           return -6;
-           }
+        // TYPE = 'Z' -  band matrix laid out for ?GBTRF
+        if( matrix_layout == LAPACK_COL_MAJOR &&
+            LAPACKE_dgb_nancheck( matrix_layout, m, n, kl, ku, a+kl, lda ) ) {
+            return -9;
+        }
+        if( matrix_layout == LAPACK_ROW_MAJOR &&
+            LAPACKE_dgb_nancheck( matrix_layout, m, n, kl, ku, a+lda*kl, lda ) ) {
+            return -9;
+        }
         break;
     }
 #endif

diff --git a/LAPACKE/src/lapacke_dlascl_work.c b/LAPACKE/src/lapacke_dlascl_work.c
index a98f3c8..e45d7c3 100644 (file)
--- a/LAPACKE/src/lapacke_dlascl_work.c
+++ b/LAPACKE/src/lapacke_dlascl_work.c
@@ -46,7 +46,10 @@ lapack_int LAPACKE_dlascl_work( int matrix_layout, char type, lapack_int kl,
             info = info - 1;
         }
     } else if( matrix_layout == LAPACK_ROW_MAJOR ) {
-        lapack_int lda_t = MAX(1,lda);
+        lapack_int nrows_a = LAPACKE_lsame(type, 'b') ? kl + 1 :
+                             LAPACKE_lsame(type, 'q') ? ku + 1 :
+                             LAPACKE_lsame(type, 'z') ? 2 * kl + ku + 1 : m;
+        lapack_int lda_t = MAX(1,nrows_a);
         double* a_t = NULL;
         /* Check leading dimension(s) */
         if( lda < n ) {
@@ -61,12 +64,14 @@ lapack_int LAPACKE_dlascl_work( int matrix_layout, char type, lapack_int kl,
             goto exit_level_0;
         }
         /* Transpose input matrices */
-        LAPACKE_dge_trans( matrix_layout, lda, n, a, lda, a_t, lda_t );
+        LAPACKE_dge_trans( matrix_layout, nrows_a, n, a, lda, a_t, lda_t );
         /* Call LAPACK function and adjust info */
         LAPACK_dlascl( &type, &kl, &ku, &cfrom, &cto, &m, &n, a_t, &lda_t, &info);
-        info = 0;  /* LAPACK call is ok! */
+        if( info < 0 ) {
+            info = info - 1;
+        }
         /* Transpose output matrices */
-        LAPACKE_dge_trans( LAPACK_COL_MAJOR, lda, n, a_t, lda_t, a, lda );
+        LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrows_a, n, a_t, lda_t, a, lda );
         /* Release memory and exit */
         LAPACKE_free( a_t );
 exit_level_0:

diff --git a/LAPACKE/src/lapacke_slascl.c b/LAPACKE/src/lapacke_slascl.c
index 0d5bd95..7d47db5 100644 (file)
--- a/LAPACKE/src/lapacke_slascl.c
+++ b/LAPACKE/src/lapacke_slascl.c
@@ -34,8 +34,8 @@
 #include "lapacke_utils.h"
 
 lapack_int LAPACKE_slascl( int matrix_layout, char type, lapack_int kl,
-                           lapack_int ku, float cfrom, float cto, 
-                           lapack_int m, lapack_int n, float* a, 
+                           lapack_int ku, float cfrom, float cto,
+                           lapack_int m, lapack_int n, float* a,
                            lapack_int lda )
 {
     if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
@@ -46,50 +46,64 @@ lapack_int LAPACKE_slascl( int matrix_layout, char type, lapack_int kl,
     /* Optionally check input matrices for NaNs */
     switch (type) {
     case 'G':
-       if( LAPACKE_sge_nancheck( matrix_layout, lda, n, a, lda ) ) {
-           return -9;
-           }
+        if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
+            return -9;
+        }
         break;
     case 'L':
-       // TYPE = 'L' - lower triangular matrix.
-       if( LAPACKE_str_nancheck( matrix_layout, 'L', 'N', n, a, lda ) ) {
-           return -9;
-          }
+        // TYPE = 'L' - lower triangle of general matrix
+        if( matrix_layout == LAPACK_COL_MAJOR &&
+            LAPACKE_sgb_nancheck( matrix_layout, m, n, m-1, 0, a, lda+1 ) ) {
+            return -9;
+        }
+        if( matrix_layout == LAPACK_ROW_MAJOR &&
+            LAPACKE_sgb_nancheck( LAPACK_COL_MAJOR, n, m, 0, m-1, a-m+1, lda+1 ) ) {
+            return -9;
+        }
         break;
     case 'U':
-       // TYPE = 'U' - upper triangular matrix
-       if( LAPACKE_str_nancheck( matrix_layout, 'U', 'N', n, a, lda ) ) {
-           return -9;
-           } 
+        // TYPE = 'U' - upper triangle of general matrix
+        if( matrix_layout == LAPACK_COL_MAJOR &&
+            LAPACKE_sgb_nancheck( matrix_layout, m, n, 0, n-1, a-n+1, lda+1 ) ) {
+            return -9;
+        }
+        if( matrix_layout == LAPACK_ROW_MAJOR &&
+            LAPACKE_sgb_nancheck( LAPACK_COL_MAJOR, n, m, n-1, 0, a, lda+1 ) ) {
+            return -9;
+        }
         break;
     case 'H':
-       // TYPE = 'H' - upper Hessenberg matrix   
-       if( LAPACKE_shs_nancheck( matrix_layout, n, a, lda ) ) {
-           return -9;
-           }    
-        break;
+        // TYPE = 'H' - part of upper Hessenberg matrix in general matrix
+        if( matrix_layout == LAPACK_COL_MAJOR &&
+            LAPACKE_sgb_nancheck( matrix_layout, m, n, 1, n-1, a-n+1, lda+1 ) ) {
+            return -9;
+        }
+        if( matrix_layout == LAPACK_ROW_MAJOR &&
+            LAPACKE_sgb_nancheck( LAPACK_COL_MAJOR, n, m, n-1, 1, a-1, lda+1 ) ) {
+            return -9;
+        }
     case 'B':
-       // TYPE = 'B' - A is a symmetric band matrix with lower bandwidth KL
-       //             and upper bandwidth KU and with the only the lower
-       //             half stored.   
-       if( LAPACKE_ssb_nancheck( matrix_layout, 'L', n, kl, a, lda ) ) {
-           return -9;
-           }
-         break;
-   case 'Q':
-       // TYPE = 'Q' - A is a symmetric band matrix with lower bandwidth KL
-       //             and upper bandwidth KU and with the only the upper
-       //             half stored.   
-       if( LAPACKE_ssb_nancheck( matrix_layout, 'U', n, ku, a, lda ) ) {
-           return -9;
-           }
+        // TYPE = 'B' - lower part of symmetric band matrix (assume m==n)
+        if( LAPACKE_ssb_nancheck( matrix_layout, 'L', n, kl, a, lda ) ) {
+            return -9;
+        }
+        break;
+    case 'Q':
+        // TYPE = 'Q' - upper part of symmetric band matrix (assume m==n)
+        if( LAPACKE_ssb_nancheck( matrix_layout, 'U', n, ku, a, lda ) ) {
+            return -9;
+        }
         break;
     case 'Z':
-       // TYPE = 'Z' -  A is a band matrix with lower bandwidth KL and upper
-       //             bandwidth KU. See DGBTRF for storage details.        
-       if( LAPACKE_sgb_nancheck( matrix_layout, n, n, kl, kl+ku, a, lda ) ) {
-           return -6;
-           }
+        // TYPE = 'Z' -  band matrix laid out for ?GBTRF
+        if( matrix_layout == LAPACK_COL_MAJOR &&
+            LAPACKE_sgb_nancheck( matrix_layout, m, n, kl, ku, a+kl, lda ) ) {
+            return -9;
+        }
+        if( matrix_layout == LAPACK_ROW_MAJOR &&
+            LAPACKE_sgb_nancheck( matrix_layout, m, n, kl, ku, a+lda*kl, lda ) ) {
+            return -9;
+        }
         break;
     }
 #endif

diff --git a/LAPACKE/src/lapacke_slascl_work.c b/LAPACKE/src/lapacke_slascl_work.c
index 4abb59c..da769e5 100644 (file)
--- a/LAPACKE/src/lapacke_slascl_work.c
+++ b/LAPACKE/src/lapacke_slascl_work.c
@@ -46,7 +46,10 @@ lapack_int LAPACKE_slascl_work( int matrix_layout, char type, lapack_int kl,
             info = info - 1;
         }
     } else if( matrix_layout == LAPACK_ROW_MAJOR ) {
-        lapack_int lda_t = MAX(1,lda);
+        lapack_int nrows_a = LAPACKE_lsame(type, 'b') ? kl + 1 :
+                             LAPACKE_lsame(type, 'q') ? ku + 1 :
+                             LAPACKE_lsame(type, 'z') ? 2 * kl + ku + 1 : m;
+        lapack_int lda_t = MAX(1,nrows_a);
         float* a_t = NULL;
         /* Check leading dimension(s) */
         if( lda < n ) {
@@ -61,12 +64,14 @@ lapack_int LAPACKE_slascl_work( int matrix_layout, char type, lapack_int kl,
             goto exit_level_0;
         }
         /* Transpose input matrices */
-        LAPACKE_sge_trans( matrix_layout, lda, n, a, lda, a_t, lda_t );
+        LAPACKE_sge_trans( matrix_layout, nrows_a, n, a, lda, a_t, lda_t );
         /* Call LAPACK function and adjust info */
         LAPACK_slascl( &type, &kl, &ku, &cfrom, &cto, &m, &n, a_t, &lda_t, &info);
-        info = 0;  /* LAPACK call is ok! */
+        if( info < 0 ) {
+            info = info - 1;
+        }
         /* Transpose output matrices */
-        LAPACKE_sge_trans( LAPACK_COL_MAJOR, lda, n, a_t, lda_t, a, lda );
+        LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_a, n, a_t, lda_t, a, lda );
         /* Release memory and exit */
         LAPACKE_free( a_t );
 exit_level_0:

diff --git a/LAPACKE/src/lapacke_zlascl.c b/LAPACKE/src/lapacke_zlascl.c
index e4c1bb0..f063de2 100644 (file)
--- a/LAPACKE/src/lapacke_zlascl.c
+++ b/LAPACKE/src/lapacke_zlascl.c
@@ -42,54 +42,68 @@ lapack_int LAPACKE_zlascl( int matrix_layout, char type, lapack_int kl,
         LAPACKE_xerbla( "LAPACKE_zlascl", -1 );
         return -1;
     }
-#ifndef LAPACK_zISABLE_NAN_CHECK
+#ifndef LAPACK_DISABLE_NAN_CHECK
     /* Optionally check input matrices for NaNs */
     switch (type) {
     case 'G':
-       if( LAPACKE_zge_nancheck( matrix_layout, lda, n, a, lda ) ) {
-           return -9;
-           }
+        if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
+            return -9;
+        }
         break;
     case 'L':
-       // TYPE = 'L' - lower triangular matrix.
-       if( LAPACKE_ztr_nancheck( matrix_layout, 'L', 'N', n, a, lda ) ) {
-           return -9;
-          }
+        // TYPE = 'L' - lower triangle of general matrix
+        if( matrix_layout == LAPACK_COL_MAJOR &&
+            LAPACKE_zgb_nancheck( matrix_layout, m, n, m-1, 0, a, lda+1 ) ) {
+            return -9;
+        }
+        if( matrix_layout == LAPACK_ROW_MAJOR &&
+            LAPACKE_zgb_nancheck( LAPACK_COL_MAJOR, n, m, 0, m-1, a-m+1, lda+1 ) ) {
+            return -9;
+        }
         break;
     case 'U':
-       // TYPE = 'U' - upper triangular matrix
-       if( LAPACKE_ztr_nancheck( matrix_layout, 'U', 'N', n, a, lda ) ) {
-           return -9;
-           } 
+        // TYPE = 'U' - upper triangle of general matrix
+        if( matrix_layout == LAPACK_COL_MAJOR &&
+            LAPACKE_zgb_nancheck( matrix_layout, m, n, 0, n-1, a-n+1, lda+1 ) ) {
+            return -9;
+        }
+        if( matrix_layout == LAPACK_ROW_MAJOR &&
+            LAPACKE_zgb_nancheck( LAPACK_COL_MAJOR, n, m, n-1, 0, a, lda+1 ) ) {
+            return -9;
+        }
         break;
     case 'H':
-       // TYPE = 'H' - upper Hessenberg matrix   
-       if( LAPACKE_zhs_nancheck( matrix_layout, n, a, lda ) ) {
-           return -9;
-           }    
-        break;
+        // TYPE = 'H' - part of upper Hessenberg matrix in general matrix
+        if( matrix_layout == LAPACK_COL_MAJOR &&
+            LAPACKE_zgb_nancheck( matrix_layout, m, n, 1, n-1, a-n+1, lda+1 ) ) {
+            return -9;
+        }
+        if( matrix_layout == LAPACK_ROW_MAJOR &&
+            LAPACKE_zgb_nancheck( LAPACK_COL_MAJOR, n, m, n-1, 1, a-1, lda+1 ) ) {
+            return -9;
+        }
     case 'B':
-       // TYPE = 'B' - A is a symmetric band matrix with lower bandwidth KL
-       //             and upper bandwidth KU and with the only the lower
-       //             half stored.   
-       if( LAPACKE_zhb_nancheck( matrix_layout, 'L', n, kl, a, lda ) ) {
-           return -9;
-           }
-         break;
-   case 'Q':
-       // TYPE = 'Q' - A is a symmetric band matrix with lower bandwidth KL
-       //             and upper bandwidth KU and with the only the upper
-       //             half stored.   
-       if( LAPACKE_zhb_nancheck( matrix_layout, 'U', n, ku, a, lda ) ) {
-           return -9;
-           }
+        // TYPE = 'B' - lower part of symmetric band matrix (assume m==n)
+        if( LAPACKE_zhb_nancheck( matrix_layout, 'L', n, kl, a, lda ) ) {
+            return -9;
+        }
+        break;
+    case 'Q':
+        // TYPE = 'Q' - upper part of symmetric band matrix (assume m==n)
+        if( LAPACKE_zhb_nancheck( matrix_layout, 'U', n, ku, a, lda ) ) {
+            return -9;
+        }
         break;
     case 'Z':
-       // TYPE = 'Z' -  A is a band matrix with lower bandwidth KL and upper
-       //             bandwidth KU. See DGBTRF for storage details.        
-       if( LAPACKE_zgb_nancheck( matrix_layout, n, n, kl, kl+ku, a, lda ) ) {
-           return -6;
-           }
+        // TYPE = 'Z' -  band matrix laid out for ?GBTRF
+        if( matrix_layout == LAPACK_COL_MAJOR &&
+            LAPACKE_zgb_nancheck( matrix_layout, m, n, kl, ku, a+kl, lda ) ) {
+            return -9;
+        }
+        if( matrix_layout == LAPACK_ROW_MAJOR &&
+            LAPACKE_zgb_nancheck( matrix_layout, m, n, kl, ku, a+lda*kl, lda ) ) {
+            return -9;
+        }
         break;
     }
 #endif

diff --git a/LAPACKE/src/lapacke_zlascl_work.c b/LAPACKE/src/lapacke_zlascl_work.c
index d8a76a8..33f77f2 100644 (file)
--- a/LAPACKE/src/lapacke_zlascl_work.c
+++ b/LAPACKE/src/lapacke_zlascl_work.c
@@ -46,7 +46,10 @@ lapack_int LAPACKE_zlascl_work( int matrix_layout, char type, lapack_int kl,
             info = info - 1;
         }
     } else if( matrix_layout == LAPACK_ROW_MAJOR ) {
-        lapack_int lda_t = MAX(1,lda);
+        lapack_int nrows_a = LAPACKE_lsame(type, 'b') ? kl + 1 :
+                             LAPACKE_lsame(type, 'q') ? ku + 1 :
+                             LAPACKE_lsame(type, 'z') ? 2 * kl + ku + 1 : m;
+        lapack_int lda_t = MAX(1,nrows_a);
         lapack_complex_double* a_t = NULL;
         /* Check leading dimension(s) */
         if( lda < n ) {
@@ -62,12 +65,14 @@ lapack_int LAPACKE_zlascl_work( int matrix_layout, char type, lapack_int kl,
             goto exit_level_0;
         }
         /* Transpose input matrices */
-        LAPACKE_zge_trans( matrix_layout, lda, n, a, lda, a_t, lda_t );
+        LAPACKE_zge_trans( matrix_layout, nrows_a, n, a, lda, a_t, lda_t );
         /* Call LAPACK function and adjust info */
         LAPACK_zlascl( &type, &kl, &ku, &cfrom, &cto, &m, &n, a_t, &lda_t, &info);
-        info = 0;  /* LAPACK call is ok! */
+        if( info < 0 ) {
+            info = info - 1;
+        }
         /* Transpose output matrices */
-        LAPACKE_zge_trans( LAPACK_COL_MAJOR, lda, n, a_t, lda_t, a, lda );
+        LAPACKE_zge_trans( LAPACK_COL_MAJOR, nrows_a, n, a_t, lda_t, a, lda );
         /* Release memory and exit */
         LAPACKE_free( a_t );
 exit_level_0: