Merge pull request #3817 from martin-frbg/lapack738742

Add NaN check functions for trapezoidal matrices to LAPACKE (Reference-LAPACK PR 738+742)

cmake/lapacke.cmake

@@ -2481,6 +2481,8 @@ set(Utils_SRC
   lapacke_ctp_nancheck.c          lapacke_dtr_trans.c             lapacke_str_trans.c             lapacke_ztp_trans.c
   lapacke_ctp_trans.c             lapacke_lsame.c                 lapacke_xerbla.c                lapacke_ztr_nancheck.c
   lapacke_ctr_nancheck.c          lapacke_make_complex_double.c   lapacke_z_nancheck.c            lapacke_ztr_trans.c
+  lapacke_ctz_nancheck.c          lapacke_ctz_trans.c             lapacke_dtz_nancheck.c          lapacke_dtz_trans.c
+  lapacke_stz_nancheck.c          lapacke_stz_trans.c             lapacke_ztz_nancheck.c          lapacke_ztz_trans.c
 )
 
 set(LAPACKE_REL_SRC "")

lapack-netlib/LAPACKE/include/lapacke_utils.h

@@ -68,7 +68,7 @@ void LAPACKE_xerbla( const char *name, lapack_int info );
 /* Compare two chars (case-insensitive) */
 lapack_logical LAPACKE_lsame( char ca,  char cb )
 #if defined __GNUC__
-	__attribute__((const))
+  __attribute__((const))
 #endif
 	;
 
@@ -128,6 +128,10 @@ void LAPACKE_ctp_trans( int matrix_layout, char uplo, char diag,
 void LAPACKE_ctr_trans( int matrix_layout, char uplo, char diag, lapack_int n,
                         const lapack_complex_float *in, lapack_int ldin,
                         lapack_complex_float *out, lapack_int ldout );
+void LAPACKE_ctz_trans( int matrix_layout, char direct, char uplo,
+                        char diag, lapack_int m, lapack_int n,
+                        const lapack_complex_float *in, lapack_int ldin,
+                        lapack_complex_float *out, lapack_int ldout );
 
 void LAPACKE_dgb_trans( int matrix_layout, lapack_int m, lapack_int n,
                         lapack_int kl, lapack_int ku,
@@ -178,6 +182,10 @@ void LAPACKE_dtp_trans( int matrix_layout, char uplo, char diag,
 void LAPACKE_dtr_trans( int matrix_layout, char uplo, char diag, lapack_int n,
                         const double *in, lapack_int ldin,
                         double *out, lapack_int ldout );
+void LAPACKE_dtz_trans( int matrix_layout, char direct, char uplo,
+                        char diag, lapack_int m, lapack_int n,
+                        const double *in, lapack_int ldin,
+                        double *out, lapack_int ldout );
 
 void LAPACKE_sgb_trans( int matrix_layout, lapack_int m, lapack_int n,
                         lapack_int kl, lapack_int ku,
@@ -228,6 +236,10 @@ void LAPACKE_stp_trans( int matrix_layout, char uplo, char diag,
 void LAPACKE_str_trans( int matrix_layout, char uplo, char diag, lapack_int n,
                         const float *in, lapack_int ldin,
                         float *out, lapack_int ldout );
+void LAPACKE_stz_trans( int matrix_layout, char direct, char uplo,
+                        char diag, lapack_int m, lapack_int n,
+                        const float *in, lapack_int ldin,
+                        float *out, lapack_int ldout );
 
 void LAPACKE_zgb_trans( int matrix_layout, lapack_int m, lapack_int n,
                         lapack_int kl, lapack_int ku,
@@ -284,6 +296,10 @@ void LAPACKE_ztp_trans( int matrix_layout, char uplo, char diag,
 void LAPACKE_ztr_trans( int matrix_layout, char uplo, char diag, lapack_int n,
                         const lapack_complex_double *in, lapack_int ldin,
                         lapack_complex_double *out, lapack_int ldout );
+void LAPACKE_ztz_trans( int matrix_layout, char direct, char uplo,
+                        char diag, lapack_int m, lapack_int n,
+                        const lapack_complex_double *in, lapack_int ldin,
+                        lapack_complex_double *out, lapack_int ldout );
 
 /* NaN checkers */
 #define LAPACK_SISNAN( x ) ( x != x )
@@ -376,6 +392,10 @@ lapack_logical LAPACKE_ctr_nancheck( int matrix_layout, char uplo, char diag,
                                       lapack_int n,
                                       const lapack_complex_float *a,
                                       lapack_int lda );
+lapack_logical LAPACKE_ctz_nancheck( int matrix_layout, char direct, char uplo,
+                                     char diag, lapack_int m, lapack_int n,
+                                     const lapack_complex_float *a,
+                                     lapack_int lda );
 
 lapack_logical LAPACKE_dgb_nancheck( int matrix_layout, lapack_int m,
                                       lapack_int n, lapack_int kl,
@@ -440,6 +460,9 @@ lapack_logical LAPACKE_dtr_nancheck( int matrix_layout, char uplo, char diag,
                                       lapack_int n,
                                       const double *a,
                                       lapack_int lda );
+lapack_logical LAPACKE_dtz_nancheck( int matrix_layout, char direct, char uplo,
+                                     char diag, lapack_int m, lapack_int n,
+                                     const double *a, lapack_int lda );
 
 lapack_logical LAPACKE_sgb_nancheck( int matrix_layout, lapack_int m,
                                       lapack_int n, lapack_int kl,
@@ -504,6 +527,9 @@ lapack_logical LAPACKE_str_nancheck( int matrix_layout, char uplo, char diag,
                                       lapack_int n,
                                       const float *a,
                                       lapack_int lda );
+lapack_logical LAPACKE_stz_nancheck( int matrix_layout, char direct, char uplo,
+                                     char diag, lapack_int m, lapack_int n,
+                                     const float *a, lapack_int lda );
 
 lapack_logical LAPACKE_zgb_nancheck( int matrix_layout, lapack_int m,
                                       lapack_int n, lapack_int kl,
@@ -574,6 +600,10 @@ lapack_logical LAPACKE_ztr_nancheck( int matrix_layout, char uplo, char diag,
                                       lapack_int n,
                                       const lapack_complex_double *a,
                                       lapack_int lda );
+lapack_logical LAPACKE_ztz_nancheck( int matrix_layout, char direct, char uplo,
+                                     char diag, lapack_int m, lapack_int n,
+                                     const lapack_complex_double *a,
+                                     lapack_int lda );
 
 #ifdef __cplusplus
 }

lapack-netlib/LAPACKE/src/lapacke_clantr.c

@@ -33,8 +33,8 @@
 #include "lapacke_utils.h"
 
 float LAPACKE_clantr( int matrix_layout, char norm, char uplo, char diag,
-                           lapack_int m, lapack_int n, const lapack_complex_float* a,
-                           lapack_int lda )
+                      lapack_int m, lapack_int n, const lapack_complex_float* a,
+                      lapack_int lda )
 {
     lapack_int info = 0;
     float res = 0.;
@@ -46,7 +46,7 @@ float LAPACKE_clantr( int matrix_layout, char norm, char uplo, char diag,
 #ifndef LAPACK_DISABLE_NAN_CHECK
     if( LAPACKE_get_nancheck() ) {
         /* Optionally check input matrices for NaNs */
-        if( LAPACKE_ctr_nancheck( matrix_layout, uplo, diag, MIN(m,n), a, lda ) ) {
+        if( LAPACKE_ctz_nancheck( matrix_layout, 'f', uplo, diag, m, n, a, lda ) ) {
             return -7;
         }
     }

lapack-netlib/LAPACKE/src/lapacke_clarfb.c

@@ -42,7 +42,9 @@ lapack_int LAPACKE_clarfb( int matrix_layout, char side, char trans, char direct
     lapack_int info = 0;
     lapack_int ldwork;
     lapack_complex_float* work = NULL;
-    lapack_int ncols_v, nrows_v;
+    lapack_int nrows_v, ncols_v;
+    lapack_logical left, col, forward;
+    char uplo;
     if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
         LAPACKE_xerbla( "LAPACKE_clarfb", -1 );
         return -1;
@@ -50,59 +52,27 @@ lapack_int LAPACKE_clarfb( int matrix_layout, char side, char trans, char direct
 #ifndef LAPACK_DISABLE_NAN_CHECK
     if( LAPACKE_get_nancheck() ) {
         /* Optionally check input matrices for NaNs */
-        lapack_int lrv, lcv;  /* row, column stride */
-        if( matrix_layout == LAPACK_COL_MAJOR ) {
-            lrv = 1;
-            lcv = ldv;
-        } else {
-            lrv = ldv;
-            lcv = 1;
-        }
-        ncols_v =     LAPACKE_lsame( storev, 'c' ) ? k :
-                  ( ( LAPACKE_lsame( storev, 'r' ) && LAPACKE_lsame( side, 'l' ) ) ? m :
-                  ( ( LAPACKE_lsame( storev, 'r' ) && LAPACKE_lsame( side, 'r' ) ) ? n : 1) );
+        left = LAPACKE_lsame( side, 'l' );
+        col = LAPACKE_lsame( storev, 'c' );
+        forward = LAPACKE_lsame( direct, 'f' );
 
-        nrows_v =   ( LAPACKE_lsame( storev, 'c' ) && LAPACKE_lsame( side, 'l' ) ) ? m :
-                  ( ( LAPACKE_lsame( storev, 'c' ) && LAPACKE_lsame( side, 'r' ) ) ? n :
-                    ( LAPACKE_lsame( storev, 'r' ) ? k : 1) );
-        if( LAPACKE_cge_nancheck( matrix_layout, m, n, c, ldc ) ) {
-            return -13;
+        nrows_v = ( col && left ) ? m : ( ( col && !left ) ? n : ( !col ? k : 1) );
+        ncols_v = ( !col && left ) ? m : ( ( !col && !left ) ? n : ( col ? k : 1 ) );
+        uplo = ( ( left && col ) || !( left || col ) ) ? 'l' : 'u';
+
+        if( !forward && ( col && k > nrows_v ) || ( !col && k > ncols_v )) {
+            LAPACKE_xerbla( "LAPACKE_clarfb", -8 );
+            return -8;
+        }
+        if( LAPACKE_ctz_nancheck( matrix_layout, direct, uplo, 'u',
+                                  nrows_v, ncols_v, v, ldv ) ) {
+            return -9;
         }
         if( LAPACKE_cge_nancheck( matrix_layout, k, k, t, ldt ) ) {
             return -11;
         }
-        if( LAPACKE_lsame( storev, 'c' ) && LAPACKE_lsame( direct, 'f' ) ) {
-            if( LAPACKE_ctr_nancheck( matrix_layout, 'l', 'u', k, v, ldv ) )
-                return -9;
-            if( LAPACKE_cge_nancheck( matrix_layout, nrows_v-k, ncols_v,
-                                      &v[k*lrv], ldv ) )
-                return -9;
-        } else if( LAPACKE_lsame( storev, 'c' ) && LAPACKE_lsame( direct, 'b' ) ) {
-            if( k > nrows_v ) {
-                LAPACKE_xerbla( "LAPACKE_clarfb", -8 );
-                return -8;
-            }
-            if( LAPACKE_ctr_nancheck( matrix_layout, 'u', 'u', k,
-                                      &v[(nrows_v-k)*lrv], ldv ) )
-                return -9;
-            if( LAPACKE_cge_nancheck( matrix_layout, nrows_v-k, ncols_v, v, ldv ) )
-                return -9;
-        } else if( LAPACKE_lsame( storev, 'r' ) && LAPACKE_lsame( direct, 'f' ) ) {
-            if( LAPACKE_ctr_nancheck( matrix_layout, 'u', 'u', k, v, ldv ) )
-                return -9;
-            if( LAPACKE_cge_nancheck( matrix_layout, nrows_v, ncols_v-k,
-                                      &v[k*lrv], ldv ) )
-                return -9;
-        } else if( LAPACKE_lsame( storev, 'r' ) && LAPACKE_lsame( direct, 'b' ) ) {
-            if( k > ncols_v ) {
-                LAPACKE_xerbla( "LAPACKE_clarfb", -8 );
-                return -8;
-            }
-            if( LAPACKE_ctr_nancheck( matrix_layout, 'l', 'u', k,
-                                      &v[(ncols_v-k)*lcv], ldv ) )
-                return -9;
-            if( LAPACKE_cge_nancheck( matrix_layout, nrows_v, ncols_v-k, v, ldv ) )
-                return -9;
+        if( LAPACKE_cge_nancheck( matrix_layout, m, n, c, ldc ) ) {
+            return -13;
         }
     }
 #endif

lapack-netlib/LAPACKE/src/lapacke_clarfb_work.c

@@ -42,6 +42,8 @@ lapack_int LAPACKE_clarfb_work( int matrix_layout, char side, char trans,
 {
     lapack_int info = 0;
     lapack_int nrows_v, ncols_v;
+    lapack_logical left, col, forward;
+    char uplo;
     lapack_int ldc_t, ldt_t, ldv_t;
     lapack_complex_float *v_t = NULL, *t_t = NULL, *c_t = NULL;
     if( matrix_layout == LAPACK_COL_MAJOR ) {
@@ -52,16 +54,14 @@ lapack_int LAPACKE_clarfb_work( int matrix_layout, char side, char trans,
             info = info - 1;
         }
     } else if( matrix_layout == LAPACK_ROW_MAJOR ) {
-        nrows_v = ( LAPACKE_lsame( storev, 'c' ) &&
-                             LAPACKE_lsame( side, 'l' ) ) ? m :
-                             ( ( LAPACKE_lsame( storev, 'c' ) &&
-                             LAPACKE_lsame( side, 'r' ) ) ? n :
-                             ( LAPACKE_lsame( storev, 'r' ) ? k : 1) );
-        ncols_v = LAPACKE_lsame( storev, 'c' ) ? k :
-                             ( ( LAPACKE_lsame( storev, 'r' ) &&
-                             LAPACKE_lsame( side, 'l' ) ) ? m :
-                             ( ( LAPACKE_lsame( storev, 'r' ) &&
-                             LAPACKE_lsame( side, 'r' ) ) ? n : 1) );
+        left = LAPACKE_lsame( side, 'l' );
+        col = LAPACKE_lsame( storev, 'c' );
+        forward = LAPACKE_lsame( direct, 'f' );
+
+        nrows_v = ( col && left ) ? m : ( ( col && !left ) ? n : ( !col ? k : 1) );
+        ncols_v = ( !col && left ) ? m : ( ( !col && !left ) ? n : ( col ? k : 1 ) );
+        uplo = ( ( left && col ) || !( left || col ) ) ? 'l' : 'u';
+
         ldc_t = MAX(1,m);
         ldt_t = MAX(1,k);
         ldv_t = MAX(1,nrows_v);
@@ -81,6 +81,11 @@ lapack_int LAPACKE_clarfb_work( int matrix_layout, char side, char trans,
             LAPACKE_xerbla( "LAPACKE_clarfb_work", info );
             return info;
         }
+        if( !forward && ( col && k > nrows_v ) || ( !col && k > ncols_v )) {
+            info = -8;
+            LAPACKE_xerbla( "LAPACKE_clarfb_work", info );
+            return info;
+        }
         /* Allocate memory for temporary array(s) */
         v_t = (lapack_complex_float*)
             LAPACKE_malloc( sizeof(lapack_complex_float) *
@@ -102,36 +107,8 @@ lapack_int LAPACKE_clarfb_work( int matrix_layout, char side, char trans,
             goto exit_level_2;
         }
         /* Transpose input matrices */
-        if( LAPACKE_lsame( storev, 'c' ) && LAPACKE_lsame( direct, 'f' ) ) {
-            LAPACKE_ctr_trans( matrix_layout, 'l', 'u', k, v, ldv, v_t, ldv_t );
-            LAPACKE_cge_trans( matrix_layout, nrows_v-k, ncols_v, &v[k*ldv], ldv,
-                               &v_t[k], ldv_t );
-        } else if( LAPACKE_lsame( storev, 'c' ) &&
-                   LAPACKE_lsame( direct, 'b' ) ) {
-            if( k > nrows_v ) {
-                LAPACKE_xerbla( "LAPACKE_clarfb_work", -8 );
-                return -8;
-            }
-            LAPACKE_ctr_trans( matrix_layout, 'u', 'u', k, &v[(nrows_v-k)*ldv],
-                               ldv, &v_t[nrows_v-k], ldv_t );
-            LAPACKE_cge_trans( matrix_layout, nrows_v-k, ncols_v, v, ldv, v_t,
-                               ldv_t );
-        } else if( LAPACKE_lsame( storev, 'r' ) &&
-                   LAPACKE_lsame( direct, 'f' ) ) {
-            LAPACKE_ctr_trans( matrix_layout, 'u', 'u', k, v, ldv, v_t, ldv_t );
-            LAPACKE_cge_trans( matrix_layout, nrows_v, ncols_v-k, &v[k], ldv,
-                               &v_t[k*ldv_t], ldv_t );
-        } else if( LAPACKE_lsame( storev, 'r' ) &&
-                   LAPACKE_lsame( direct, 'b' ) ) {
-            if( k > ncols_v ) {
-                LAPACKE_xerbla( "LAPACKE_clarfb_work", -8 );
-                return -8;
-            }
-            LAPACKE_ctr_trans( matrix_layout, 'l', 'u', k, &v[ncols_v-k], ldv,
-                               &v_t[(ncols_v-k)*ldv_t], ldv_t );
-            LAPACKE_cge_trans( matrix_layout, nrows_v, ncols_v-k, v, ldv, v_t,
-                               ldv_t );
-        }
+        LAPACKE_ctz_trans( matrix_layout, direct, uplo, 'u', nrows_v, ncols_v,
+                           v, ldv, v_t, ldv_t );
         LAPACKE_cge_trans( matrix_layout, k, k, t, ldt, t_t, ldt_t );
         LAPACKE_cge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t );
         /* Call LAPACK function and adjust info */

lapack-netlib/LAPACKE/src/lapacke_dlantr.c

@@ -46,7 +46,7 @@ double LAPACKE_dlantr( int matrix_layout, char norm, char uplo, char diag,
 #ifndef LAPACK_DISABLE_NAN_CHECK
     if( LAPACKE_get_nancheck() ) {
         /* Optionally check input matrices for NaNs */
-        if( LAPACKE_dtr_nancheck( matrix_layout, uplo, diag, MIN(m,n), a, lda ) ) {
+        if( LAPACKE_dtz_nancheck( matrix_layout, 'f', uplo, diag, m, n, a, lda ) ) {
             return -7;
         }
     }

lapack-netlib/LAPACKE/src/lapacke_dlarfb.c

@@ -41,7 +41,9 @@ lapack_int LAPACKE_dlarfb( int matrix_layout, char side, char trans, char direct
     lapack_int info = 0;
     lapack_int ldwork;
     double* work = NULL;
-    lapack_int ncols_v, nrows_v;
+    lapack_int nrows_v, ncols_v;
+    lapack_logical left, col, forward;
+    char uplo;
     if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
         LAPACKE_xerbla( "LAPACKE_dlarfb", -1 );
         return -1;
@@ -49,59 +51,27 @@ lapack_int LAPACKE_dlarfb( int matrix_layout, char side, char trans, char direct
 #ifndef LAPACK_DISABLE_NAN_CHECK
     if( LAPACKE_get_nancheck() ) {
         /* Optionally check input matrices for NaNs */
-        lapack_int lrv, lcv;  /* row, column stride */
-        if( matrix_layout == LAPACK_COL_MAJOR ) {
-            lrv = 1;
-            lcv = ldv;
-        } else {
-            lrv = ldv;
-            lcv = 1;
-        }
-        ncols_v =     LAPACKE_lsame( storev, 'c' ) ? k :
-                  ( ( LAPACKE_lsame( storev, 'r' ) && LAPACKE_lsame( side, 'l' ) ) ? m :
-                  ( ( LAPACKE_lsame( storev, 'r' ) && LAPACKE_lsame( side, 'r' ) ) ? n : 1) );
+        left = LAPACKE_lsame( side, 'l' );
+        col = LAPACKE_lsame( storev, 'c' );
+        forward = LAPACKE_lsame( direct, 'f' );
 
-        nrows_v =   ( LAPACKE_lsame( storev, 'c' ) && LAPACKE_lsame( side, 'l' ) ) ? m :
-                  ( ( LAPACKE_lsame( storev, 'c' ) && LAPACKE_lsame( side, 'r' ) ) ? n :
-                    ( LAPACKE_lsame( storev, 'r' ) ? k : 1) );
-        if( LAPACKE_dge_nancheck( matrix_layout, m, n, c, ldc ) ) {
-            return -13;
+        nrows_v = ( col && left ) ? m : ( ( col && !left ) ? n : ( !col ? k : 1) );
+        ncols_v = ( !col && left ) ? m : ( ( !col && !left ) ? n : ( col ? k : 1 ) );
+        uplo = ( ( left && col ) || !( left || col ) ) ? 'l' : 'u';
+
+        if( !forward && ( col && k > nrows_v ) || ( !col && k > ncols_v )) {
+            LAPACKE_xerbla( "LAPACKE_dlarfb", -8 );
+            return -8;
+        }
+        if( LAPACKE_dtz_nancheck( matrix_layout, direct, uplo, 'u',
+                                  nrows_v, ncols_v, v, ldv ) ) {
+            return -9;
         }
         if( LAPACKE_dge_nancheck( matrix_layout, k, k, t, ldt ) ) {
             return -11;
         }
-        if( LAPACKE_lsame( storev, 'c' ) && LAPACKE_lsame( direct, 'f' ) ) {
-            if( LAPACKE_dtr_nancheck( matrix_layout, 'l', 'u', k, v, ldv ) )
-                return -9;
-            if( LAPACKE_dge_nancheck( matrix_layout, nrows_v-k, ncols_v,
-                                      &v[k*lrv], ldv ) )
-                return -9;
-        } else if( LAPACKE_lsame( storev, 'c' ) && LAPACKE_lsame( direct, 'b' ) ) {
-            if( k > nrows_v ) {
-                LAPACKE_xerbla( "LAPACKE_dlarfb", -8 );
-                return -8;
-            }
-            if( LAPACKE_dtr_nancheck( matrix_layout, 'u', 'u', k,
-                                      &v[(nrows_v-k)*lrv], ldv ) )
-                return -9;
-            if( LAPACKE_dge_nancheck( matrix_layout, nrows_v-k, ncols_v, v, ldv ) )
-                return -9;
-        } else if( LAPACKE_lsame( storev, 'r' ) && LAPACKE_lsame( direct, 'f' ) ) {
-            if( LAPACKE_dtr_nancheck( matrix_layout, 'u', 'u', k, v, ldv ) )
-                return -9;
-            if( LAPACKE_dge_nancheck( matrix_layout, nrows_v, ncols_v-k,
-                                      &v[k*lrv], ldv ) )
-                return -9;
-        } else if( LAPACKE_lsame( storev, 'r' ) && LAPACKE_lsame( direct, 'b' ) ) {
-            if( k > ncols_v ) {
-                LAPACKE_xerbla( "LAPACKE_dlarfb", -8 );
-                return -8;
-            }
-            if( LAPACKE_dtr_nancheck( matrix_layout, 'l', 'u', k,
-                                      &v[(ncols_v-k)*lcv], ldv ) )
-                return -9;
-            if( LAPACKE_dge_nancheck( matrix_layout, nrows_v, ncols_v-k, v, ldv ) )
-                return -9;
+        if( LAPACKE_dge_nancheck( matrix_layout, m, n, c, ldc ) ) {
+            return -13;
         }
     }
 #endif

lapack-netlib/LAPACKE/src/lapacke_dlarfb_work.c

@@ -41,6 +41,8 @@ lapack_int LAPACKE_dlarfb_work( int matrix_layout, char side, char trans,
 {
     lapack_int info = 0;
     lapack_int nrows_v, ncols_v;
+    lapack_logical left, col, forward;
+    char uplo;
     lapack_int ldc_t, ldt_t, ldv_t;
     double *v_t = NULL, *t_t = NULL, *c_t = NULL;
     if( matrix_layout == LAPACK_COL_MAJOR ) {
@@ -51,16 +53,14 @@ lapack_int LAPACKE_dlarfb_work( int matrix_layout, char side, char trans,
             info = info - 1;
         }
     } else if( matrix_layout == LAPACK_ROW_MAJOR ) {
-        nrows_v = ( LAPACKE_lsame( storev, 'c' ) &&
-                             LAPACKE_lsame( side, 'l' ) ) ? m :
-                             ( ( LAPACKE_lsame( storev, 'c' ) &&
-                             LAPACKE_lsame( side, 'r' ) ) ? n :
-                             ( LAPACKE_lsame( storev, 'r' ) ? k : 1) );
-        ncols_v = LAPACKE_lsame( storev, 'c' ) ? k :
-                             ( ( LAPACKE_lsame( storev, 'r' ) &&
-                             LAPACKE_lsame( side, 'l' ) ) ? m :
-                             ( ( LAPACKE_lsame( storev, 'r' ) &&
-                             LAPACKE_lsame( side, 'r' ) ) ? n : 1) );
+        left = LAPACKE_lsame( side, 'l' );
+        col = LAPACKE_lsame( storev, 'c' );
+        forward = LAPACKE_lsame( direct, 'f' );
+
+        nrows_v = ( col && left ) ? m : ( ( col && !left ) ? n : ( !col ? k : 1) );
+        ncols_v = ( !col && left ) ? m : ( ( !col && !left ) ? n : ( col ? k : 1 ) );
+        uplo = ( ( left && col ) || !( left || col ) ) ? 'l' : 'u';
+
         ldc_t = MAX(1,m);
         ldt_t = MAX(1,k);
         ldv_t = MAX(1,nrows_v);
@@ -80,6 +80,11 @@ lapack_int LAPACKE_dlarfb_work( int matrix_layout, char side, char trans,
             LAPACKE_xerbla( "LAPACKE_dlarfb_work", info );
             return info;
         }
+        if( !forward && ( col && k > nrows_v ) || ( !col && k > ncols_v )) {
+            info = -8;
+            LAPACKE_xerbla( "LAPACKE_dlarfb_work", info );
+            return info;
+        }
         /* Allocate memory for temporary array(s) */
         v_t = (double*)
             LAPACKE_malloc( sizeof(double) * ldv_t * MAX(1,ncols_v) );
@@ -98,36 +103,8 @@ lapack_int LAPACKE_dlarfb_work( int matrix_layout, char side, char trans,
             goto exit_level_2;
         }
         /* Transpose input matrices */
-        if( LAPACKE_lsame( storev, 'c' ) && LAPACKE_lsame( direct, 'f' ) ) {
-            LAPACKE_dtr_trans( matrix_layout, 'l', 'u', k, v, ldv, v_t, ldv_t );
-            LAPACKE_dge_trans( matrix_layout, nrows_v-k, ncols_v, &v[k*ldv], ldv,
-                               &v_t[k], ldv_t );
-        } else if( LAPACKE_lsame( storev, 'c' ) &&
-                   LAPACKE_lsame( direct, 'b' ) ) {
-            if( k > nrows_v ) {
-                LAPACKE_xerbla( "LAPACKE_dlarfb_work", -8 );
-                return -8;
-            }
-            LAPACKE_dtr_trans( matrix_layout, 'u', 'u', k, &v[(nrows_v-k)*ldv],
-                               ldv, &v_t[nrows_v-k], ldv_t );
-            LAPACKE_dge_trans( matrix_layout, nrows_v-k, ncols_v, v, ldv, v_t,
-                               ldv_t );
-        } else if( LAPACKE_lsame( storev, 'r' ) &&
-                   LAPACKE_lsame( direct, 'f' ) ) {
-            LAPACKE_dtr_trans( matrix_layout, 'u', 'u', k, v, ldv, v_t, ldv_t );
-            LAPACKE_dge_trans( matrix_layout, nrows_v, ncols_v-k, &v[k], ldv,
-                               &v_t[k*ldv_t], ldv_t );
-        } else if( LAPACKE_lsame( storev, 'r' ) &&
-                   LAPACKE_lsame( direct, 'b' ) ) {
-            if( k > ncols_v ) {
-                LAPACKE_xerbla( "LAPACKE_dlarfb_work", -8 );
-                return -8;
-            }
-            LAPACKE_dtr_trans( matrix_layout, 'l', 'u', k, &v[ncols_v-k], ldv,
-                               &v_t[(ncols_v-k)*ldv_t], ldv_t );
-            LAPACKE_dge_trans( matrix_layout, nrows_v, ncols_v-k, v, ldv, v_t,
-                               ldv_t );
-        }
+        LAPACKE_dtz_trans( matrix_layout, direct, uplo, 'u', nrows_v, ncols_v,
+                           v, ldv, v_t, ldv_t );
         LAPACKE_dge_trans( matrix_layout, k, k, t, ldt, t_t, ldt_t );
         LAPACKE_dge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t );
         /* Call LAPACK function and adjust info */

lapack-netlib/LAPACKE/src/lapacke_slantr.c

@@ -46,7 +46,7 @@ float LAPACKE_slantr( int matrix_layout, char norm, char uplo, char diag,
 #ifndef LAPACK_DISABLE_NAN_CHECK
     if( LAPACKE_get_nancheck() ) {
         /* Optionally check input matrices for NaNs */
-        if( LAPACKE_str_nancheck( matrix_layout, uplo, diag, MIN(m,n), a, lda ) ) {
+        if( LAPACKE_stz_nancheck( matrix_layout, 'f', uplo, diag, m, n, a, lda ) ) {
             return -7;
         }
     }

lapack-netlib/LAPACKE/src/lapacke_slarfb.c

@@ -41,7 +41,9 @@ lapack_int LAPACKE_slarfb( int matrix_layout, char side, char trans, char direct
     lapack_int info = 0;
     lapack_int ldwork;
     float* work = NULL;
-    lapack_int ncols_v, nrows_v;
+    lapack_int nrows_v, ncols_v;
+    lapack_logical left, col, forward;
+    char uplo;
     if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
         LAPACKE_xerbla( "LAPACKE_slarfb", -1 );
         return -1;
@@ -49,59 +51,27 @@ lapack_int LAPACKE_slarfb( int matrix_layout, char side, char trans, char direct
 #ifndef LAPACK_DISABLE_NAN_CHECK
     if( LAPACKE_get_nancheck() ) {
         /* Optionally check input matrices for NaNs */
-        lapack_int lrv, lcv;  /* row, column stride */
-        if( matrix_layout == LAPACK_COL_MAJOR ) {
-            lrv = 1;
-            lcv = ldv;
-        } else {
-            lrv = ldv;
-            lcv = 1;
-        }
-        ncols_v =     LAPACKE_lsame( storev, 'c' ) ? k :
-                  ( ( LAPACKE_lsame( storev, 'r' ) && LAPACKE_lsame( side, 'l' ) ) ? m :
-                  ( ( LAPACKE_lsame( storev, 'r' ) && LAPACKE_lsame( side, 'r' ) ) ? n : 1) );
+        left = LAPACKE_lsame( side, 'l' );
+        col = LAPACKE_lsame( storev, 'c' );
+        forward = LAPACKE_lsame( direct, 'f' );
 
-        nrows_v =   ( LAPACKE_lsame( storev, 'c' ) && LAPACKE_lsame( side, 'l' ) ) ? m :
-                  ( ( LAPACKE_lsame( storev, 'c' ) && LAPACKE_lsame( side, 'r' ) ) ? n :
-                    ( LAPACKE_lsame( storev, 'r' ) ? k : 1) );
-        if( LAPACKE_sge_nancheck( matrix_layout, m, n, c, ldc ) ) {
-            return -13;
+        nrows_v = ( col && left ) ? m : ( ( col && !left ) ? n : ( !col ? k : 1) );
+        ncols_v = ( !col && left ) ? m : ( ( !col && !left ) ? n : ( col ? k : 1 ) );
+        uplo = ( ( left && col ) || !( left || col ) ) ? 'l' : 'u';
+
+        if( !forward && ( col && k > nrows_v ) || ( !col && k > ncols_v )) {
+            LAPACKE_xerbla( "LAPACKE_slarfb", -8 );
+            return -8;
+        }
+        if( LAPACKE_stz_nancheck( matrix_layout, direct, uplo, 'u',
+                                  nrows_v, ncols_v, v, ldv ) ) {
+            return -9;
         }
         if( LAPACKE_sge_nancheck( matrix_layout, k, k, t, ldt ) ) {
             return -11;
         }
-        if( LAPACKE_lsame( storev, 'c' ) && LAPACKE_lsame( direct, 'f' ) ) {
-            if( LAPACKE_str_nancheck( matrix_layout, 'l', 'u', k, v, ldv ) )
-                return -9;
-            if( LAPACKE_sge_nancheck( matrix_layout, nrows_v-k, ncols_v,
-                                      &v[k*lrv], ldv ) )
-                return -9;
-        } else if( LAPACKE_lsame( storev, 'c' ) && LAPACKE_lsame( direct, 'b' ) ) {
-            if( k > nrows_v ) {
-                LAPACKE_xerbla( "LAPACKE_slarfb", -8 );
-                return -8;
-            }
-            if( LAPACKE_str_nancheck( matrix_layout, 'u', 'u', k,
-                                      &v[(nrows_v-k)*lrv], ldv ) )
-                return -9;
-            if( LAPACKE_sge_nancheck( matrix_layout, nrows_v-k, ncols_v, v, ldv ) )
-                return -9;
-        } else if( LAPACKE_lsame( storev, 'r' ) && LAPACKE_lsame( direct, 'f' ) ) {
-            if( LAPACKE_str_nancheck( matrix_layout, 'u', 'u', k, v, ldv ) )
-                return -9;
-            if( LAPACKE_sge_nancheck( matrix_layout, nrows_v, ncols_v-k,
-                                      &v[k*lrv], ldv ) )
-                return -9;
-        } else if( LAPACKE_lsame( storev, 'r' ) && LAPACKE_lsame( direct, 'b' ) ) {
-            if( k > ncols_v ) {
-                LAPACKE_xerbla( "LAPACKE_slarfb", -8 );
-                return -8;
-            }
-            if( LAPACKE_str_nancheck( matrix_layout, 'l', 'u', k,
-                                      &v[(ncols_v-k)*lcv], ldv ) )
-                return -9;
-            if( LAPACKE_sge_nancheck( matrix_layout, nrows_v, ncols_v-k, v, ldv ) )
-                return -9;
+        if( LAPACKE_sge_nancheck( matrix_layout, m, n, c, ldc ) ) {
+            return -13;
         }
     }
 #endif

lapack-netlib/LAPACKE/src/lapacke_slarfb_work.c

@@ -41,6 +41,8 @@ lapack_int LAPACKE_slarfb_work( int matrix_layout, char side, char trans,
 {
     lapack_int info = 0;
     lapack_int nrows_v, ncols_v;
+    lapack_logical left, col, forward;
+    char uplo;
     lapack_int ldc_t, ldt_t, ldv_t;
     float *v_t = NULL, *t_t = NULL, *c_t = NULL;
     if( matrix_layout == LAPACK_COL_MAJOR ) {
@@ -51,16 +53,14 @@ lapack_int LAPACKE_slarfb_work( int matrix_layout, char side, char trans,
             info = info - 1;
         }
     } else if( matrix_layout == LAPACK_ROW_MAJOR ) {
-        nrows_v = ( LAPACKE_lsame( storev, 'c' ) &&
-                             LAPACKE_lsame( side, 'l' ) ) ? m :
-                             ( ( LAPACKE_lsame( storev, 'c' ) &&
-                             LAPACKE_lsame( side, 'r' ) ) ? n :
-                             ( LAPACKE_lsame( storev, 'r' ) ? k : 1) );
-        ncols_v = LAPACKE_lsame( storev, 'c' ) ? k :
-                             ( ( LAPACKE_lsame( storev, 'r' ) &&
-                             LAPACKE_lsame( side, 'l' ) ) ? m :
-                             ( ( LAPACKE_lsame( storev, 'r' ) &&
-                             LAPACKE_lsame( side, 'r' ) ) ? n : 1) );
+        left = LAPACKE_lsame( side, 'l' );
+        col = LAPACKE_lsame( storev, 'c' );
+        forward = LAPACKE_lsame( direct, 'f' );
+
+        nrows_v = ( col && left ) ? m : ( ( col && !left ) ? n : ( !col ? k : 1) );
+        ncols_v = ( !col && left ) ? m : ( ( !col && !left ) ? n : ( col ? k : 1 ) );
+        uplo = ( ( left && col ) || !( left || col ) ) ? 'l' : 'u';
+
         ldc_t = MAX(1,m);
         ldt_t = MAX(1,k);
         ldv_t = MAX(1,nrows_v);
@@ -80,6 +80,11 @@ lapack_int LAPACKE_slarfb_work( int matrix_layout, char side, char trans,
             LAPACKE_xerbla( "LAPACKE_slarfb_work", info );
             return info;
         }
+        if( !forward && ( col && k > nrows_v ) || ( !col && k > ncols_v )) {
+            info = -8;
+            LAPACKE_xerbla( "LAPACKE_slarfb_work", info );
+            return info;
+        }
         /* Allocate memory for temporary array(s) */
         v_t = (float*)LAPACKE_malloc( sizeof(float) * ldv_t * MAX(1,ncols_v) );
         if( v_t == NULL ) {
@@ -97,36 +102,8 @@ lapack_int LAPACKE_slarfb_work( int matrix_layout, char side, char trans,
             goto exit_level_2;
         }
         /* Transpose input matrices */
-        if( LAPACKE_lsame( storev, 'c' ) && LAPACKE_lsame( direct, 'f' ) ) {
-            LAPACKE_str_trans( matrix_layout, 'l', 'u', k, v, ldv, v_t, ldv_t );
-            LAPACKE_sge_trans( matrix_layout, nrows_v-k, ncols_v, &v[k*ldv], ldv,
-                               &v_t[k], ldv_t );
-        } else if( LAPACKE_lsame( storev, 'c' ) &&
-                   LAPACKE_lsame( direct, 'b' ) ) {
-            if( k > nrows_v ) {
-                LAPACKE_xerbla( "LAPACKE_slarfb_work", -8 );
-                return -8;
-            }
-            LAPACKE_str_trans( matrix_layout, 'u', 'u', k, &v[(nrows_v-k)*ldv],
-                               ldv, &v_t[nrows_v-k], ldv_t );
-            LAPACKE_sge_trans( matrix_layout, nrows_v-k, ncols_v, v, ldv, v_t,
-                               ldv_t );
-        } else if( LAPACKE_lsame( storev, 'r' ) &&
-                   LAPACKE_lsame( direct, 'f' ) ) {
-            LAPACKE_str_trans( matrix_layout, 'u', 'u', k, v, ldv, v_t, ldv_t );
-            LAPACKE_sge_trans( matrix_layout, nrows_v, ncols_v-k, &v[k], ldv,
-                               &v_t[k*ldv_t], ldv_t );
-        } else if( LAPACKE_lsame( storev, 'r' ) &&
-                   LAPACKE_lsame( direct, 'b' ) ) {
-            if( k > ncols_v ) {
-                LAPACKE_xerbla( "LAPACKE_slarfb_work", -8 );
-                return -8;
-            }
-            LAPACKE_str_trans( matrix_layout, 'l', 'u', k, &v[ncols_v-k], ldv,
-                               &v_t[(ncols_v-k)*ldv_t], ldv_t );
-            LAPACKE_sge_trans( matrix_layout, nrows_v, ncols_v-k, v, ldv, v_t,
-                               ldv_t );
-        }
+        LAPACKE_stz_trans( matrix_layout, direct, uplo, 'u', nrows_v, ncols_v,
+                           v, ldv, v_t, ldv_t );
         LAPACKE_sge_trans( matrix_layout, k, k, t, ldt, t_t, ldt_t );
         LAPACKE_sge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t );
         /* Call LAPACK function and adjust info */

lapack-netlib/LAPACKE/src/lapacke_zlantr.c

@@ -46,7 +46,7 @@ double LAPACKE_zlantr( int matrix_layout, char norm, char uplo, char diag,
 #ifndef LAPACK_DISABLE_NAN_CHECK
     if( LAPACKE_get_nancheck() ) {
         /* Optionally check input matrices for NaNs */
-        if( LAPACKE_ztr_nancheck( matrix_layout, uplo, diag, MIN(m,n), a, lda ) ) {
+        if( LAPACKE_ztz_nancheck( matrix_layout, 'f', uplo, diag, m, n, a, lda ) ) {
             return -7;
         }
     }

lapack-netlib/LAPACKE/src/lapacke_zlarfb.c

@@ -42,7 +42,9 @@ lapack_int LAPACKE_zlarfb( int matrix_layout, char side, char trans, char direct
     lapack_int info = 0;
     lapack_int ldwork;
     lapack_complex_double* work = NULL;
-    lapack_int ncols_v, nrows_v;
+    lapack_int nrows_v, ncols_v;
+    lapack_logical left, col, forward;
+    char uplo;
     if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
         LAPACKE_xerbla( "LAPACKE_zlarfb", -1 );
         return -1;
@@ -50,59 +52,27 @@ lapack_int LAPACKE_zlarfb( int matrix_layout, char side, char trans, char direct
 #ifndef LAPACK_DISABLE_NAN_CHECK
     if( LAPACKE_get_nancheck() ) {
         /* Optionally check input matrices for NaNs */
-        lapack_int lrv, lcv;  /* row, column stride */
-        if( matrix_layout == LAPACK_COL_MAJOR ) {
-            lrv = 1;
-            lcv = ldv;
-        } else {
-            lrv = ldv;
-            lcv = 1;
-        }
-        ncols_v =     LAPACKE_lsame( storev, 'c' ) ? k :
-                  ( ( LAPACKE_lsame( storev, 'r' ) && LAPACKE_lsame( side, 'l' ) ) ? m :
-                  ( ( LAPACKE_lsame( storev, 'r' ) && LAPACKE_lsame( side, 'r' ) ) ? n : 1) );
+        left = LAPACKE_lsame( side, 'l' );
+        col = LAPACKE_lsame( storev, 'c' );
+        forward = LAPACKE_lsame( direct, 'f' );
 
-        nrows_v =   ( LAPACKE_lsame( storev, 'c' ) && LAPACKE_lsame( side, 'l' ) ) ? m :
-                  ( ( LAPACKE_lsame( storev, 'c' ) && LAPACKE_lsame( side, 'r' ) ) ? n :
-                    ( LAPACKE_lsame( storev, 'r' ) ? k : 1) );
-        if( LAPACKE_zge_nancheck( matrix_layout, m, n, c, ldc ) ) {
-            return -13;
+        nrows_v = ( col && left ) ? m : ( ( col && !left ) ? n : ( !col ? k : 1) );
+        ncols_v = ( !col && left ) ? m : ( ( !col && !left ) ? n : ( col ? k : 1 ) );
+        uplo = ( ( left && col ) || !( left || col ) ) ? 'l' : 'u';
+
+        if( !forward && ( col && k > nrows_v ) || ( !col && k > ncols_v )) {
+            LAPACKE_xerbla( "LAPACKE_zlarfb", -8 );
+            return -8;
+        }
+        if( LAPACKE_ztz_nancheck( matrix_layout, direct, uplo, 'u',
+                                  nrows_v, ncols_v, v, ldv ) ) {
+            return -9;
         }
         if( LAPACKE_zge_nancheck( matrix_layout, k, k, t, ldt ) ) {
             return -11;
         }
-        if( LAPACKE_lsame( storev, 'c' ) && LAPACKE_lsame( direct, 'f' ) ) {
-            if( LAPACKE_ztr_nancheck( matrix_layout, 'l', 'u', k, v, ldv ) )
-                return -9;
-            if( LAPACKE_zge_nancheck( matrix_layout, nrows_v-k, ncols_v,
-                                      &v[k*lrv], ldv ) )
-                return -9;
-        } else if( LAPACKE_lsame( storev, 'c' ) && LAPACKE_lsame( direct, 'b' ) ) {
-            if( k > nrows_v ) {
-                LAPACKE_xerbla( "LAPACKE_zlarfb", -8 );
-                return -8;
-            }
-            if( LAPACKE_ztr_nancheck( matrix_layout, 'u', 'u', k,
-                                      &v[(nrows_v-k)*lrv], ldv ) )
-                return -9;
-            if( LAPACKE_zge_nancheck( matrix_layout, nrows_v-k, ncols_v, v, ldv ) )
-                return -9;
-        } else if( LAPACKE_lsame( storev, 'r' ) && LAPACKE_lsame( direct, 'f' ) ) {
-            if( LAPACKE_ztr_nancheck( matrix_layout, 'u', 'u', k, v, ldv ) )
-                return -9;
-            if( LAPACKE_zge_nancheck( matrix_layout, nrows_v, ncols_v-k,
-                                      &v[k*lrv], ldv ) )
-                return -9;
-        } else if( LAPACKE_lsame( storev, 'r' ) && LAPACKE_lsame( direct, 'b' ) ) {
-            if( k > ncols_v ) {
-                LAPACKE_xerbla( "LAPACKE_zlarfb", -8 );
-                return -8;
-            }
-            if( LAPACKE_ztr_nancheck( matrix_layout, 'l', 'u', k,
-                                      &v[(ncols_v-k)*lcv], ldv ) )
-                return -9;
-            if( LAPACKE_zge_nancheck( matrix_layout, nrows_v, ncols_v-k, v, ldv ) )
-                return -9;
+        if( LAPACKE_zge_nancheck( matrix_layout, m, n, c, ldc ) ) {
+            return -13;
         }
     }
 #endif

lapack-netlib/LAPACKE/src/lapacke_zlarfb_work.c

@@ -42,6 +42,8 @@ lapack_int LAPACKE_zlarfb_work( int matrix_layout, char side, char trans,
 {
     lapack_int info = 0;
     lapack_int nrows_v, ncols_v;
+    lapack_logical left, col, forward;
+    char uplo;
     lapack_int ldc_t, ldt_t, ldv_t;
     lapack_complex_double *v_t = NULL, *t_t = NULL, *c_t = NULL;
     if( matrix_layout == LAPACK_COL_MAJOR ) {
@@ -52,16 +54,14 @@ lapack_int LAPACKE_zlarfb_work( int matrix_layout, char side, char trans,
             info = info - 1;
         }
     } else if( matrix_layout == LAPACK_ROW_MAJOR ) {
-        nrows_v = ( LAPACKE_lsame( storev, 'c' ) &&
-                             LAPACKE_lsame( side, 'l' ) ) ? m :
-                             ( ( LAPACKE_lsame( storev, 'c' ) &&
-                             LAPACKE_lsame( side, 'r' ) ) ? n :
-                             ( LAPACKE_lsame( storev, 'r' ) ? k : 1) );
-        ncols_v = LAPACKE_lsame( storev, 'c' ) ? k :
-                             ( ( LAPACKE_lsame( storev, 'r' ) &&
-                             LAPACKE_lsame( side, 'l' ) ) ? m :
-                             ( ( LAPACKE_lsame( storev, 'r' ) &&
-                             LAPACKE_lsame( side, 'r' ) ) ? n : 1) );
+        left = LAPACKE_lsame( side, 'l' );
+        col = LAPACKE_lsame( storev, 'c' );
+        forward = LAPACKE_lsame( direct, 'f' );
+
+        nrows_v = ( col && left ) ? m : ( ( col && !left ) ? n : ( !col ? k : 1) );
+        ncols_v = ( !col && left ) ? m : ( ( !col && !left ) ? n : ( col ? k : 1 ) );
+        uplo = ( ( left && col ) || !( left || col ) ) ? 'l' : 'u';
+
         ldc_t = MAX(1,m);
         ldt_t = MAX(1,k);
         ldv_t = MAX(1,nrows_v);
@@ -81,6 +81,11 @@ lapack_int LAPACKE_zlarfb_work( int matrix_layout, char side, char trans,
             LAPACKE_xerbla( "LAPACKE_zlarfb_work", info );
             return info;
         }
+        if( !forward && ( col && k > nrows_v ) || ( !col && k > ncols_v )) {
+            info = -8;
+            LAPACKE_xerbla( "LAPACKE_zlarfb_work", info );
+            return info;
+        }
         /* Allocate memory for temporary array(s) */
         v_t = (lapack_complex_double*)
             LAPACKE_malloc( sizeof(lapack_complex_double) *
@@ -102,36 +107,8 @@ lapack_int LAPACKE_zlarfb_work( int matrix_layout, char side, char trans,
             goto exit_level_2;
         }
         /* Transpose input matrices */
-        if( LAPACKE_lsame( storev, 'c' ) && LAPACKE_lsame( direct, 'f' ) ) {
-            LAPACKE_ztr_trans( matrix_layout, 'l', 'u', k, v, ldv, v_t, ldv_t );
-            LAPACKE_zge_trans( matrix_layout, nrows_v-k, ncols_v, &v[k*ldv], ldv,
-                               &v_t[k], ldv_t );
-        } else if( LAPACKE_lsame( storev, 'c' ) &&
-                   LAPACKE_lsame( direct, 'b' ) ) {
-            if( k > nrows_v ) {
-                LAPACKE_xerbla( "LAPACKE_zlarfb_work", -8 );
-                return -8;
-            }
-            LAPACKE_ztr_trans( matrix_layout, 'u', 'u', k, &v[(nrows_v-k)*ldv],
-                               ldv, &v_t[nrows_v-k], ldv_t );
-            LAPACKE_zge_trans( matrix_layout, nrows_v-k, ncols_v, v, ldv, v_t,
-                               ldv_t );
-        } else if( LAPACKE_lsame( storev, 'r' ) &&
-                   LAPACKE_lsame( direct, 'f' ) ) {
-            LAPACKE_ztr_trans( matrix_layout, 'u', 'u', k, v, ldv, v_t, ldv_t );
-            LAPACKE_zge_trans( matrix_layout, nrows_v, ncols_v-k, &v[k], ldv,
-                               &v_t[k*ldv_t], ldv_t );
-        } else if( LAPACKE_lsame( storev, 'r' ) &&
-                   LAPACKE_lsame( direct, 'b' ) ) {
-            if( k > ncols_v ) {
-                LAPACKE_xerbla( "LAPACKE_zlarfb_work", -8 );
-                return -8;
-            }
-            LAPACKE_ztr_trans( matrix_layout, 'l', 'u', k, &v[ncols_v-k], ldv,
-                               &v_t[(ncols_v-k)*ldv_t], ldv_t );
-            LAPACKE_zge_trans( matrix_layout, nrows_v, ncols_v-k, v, ldv, v_t,
-                               ldv_t );
-        }
+        LAPACKE_ztz_trans( matrix_layout, direct, uplo, 'u', nrows_v, ncols_v,
+                           v, ldv, v_t, ldv_t );
         LAPACKE_zge_trans( matrix_layout, k, k, t, ldt, t_t, ldt_t );
         LAPACKE_zge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t );
         /* Call LAPACK function and adjust info */

lapack-netlib/LAPACKE/utils/CMakeLists.txt

@@ -1,39 +1,46 @@
 set(UTILS
-lapacke_c_nancheck.c            lapacke_ctr_trans.c             lapacke_make_complex_float.c    lapacke_zgb_nancheck.c
-lapacke_cgb_nancheck.c          lapacke_d_nancheck.c            lapacke_s_nancheck.c            lapacke_zgb_trans.c
-lapacke_cgb_trans.c             lapacke_dgb_nancheck.c          lapacke_sgb_nancheck.c          lapacke_zge_nancheck.c
-lapacke_cge_nancheck.c          lapacke_dgb_trans.c             lapacke_sgb_trans.c             lapacke_zge_trans.c
-lapacke_cge_trans.c             lapacke_dge_nancheck.c          lapacke_sge_nancheck.c          lapacke_zgg_nancheck.c
-lapacke_cgg_nancheck.c          lapacke_dge_trans.c             lapacke_sge_trans.c             lapacke_zgg_trans.c
-lapacke_cgg_trans.c             lapacke_dgg_nancheck.c          lapacke_sgg_nancheck.c          lapacke_zgt_nancheck.c
-lapacke_cgt_nancheck.c          lapacke_dgg_trans.c             lapacke_sgg_trans.c             lapacke_zhb_nancheck.c
-lapacke_chb_nancheck.c          lapacke_dgt_nancheck.c          lapacke_sgt_nancheck.c          lapacke_zhb_trans.c
-lapacke_chb_trans.c             lapacke_dhs_nancheck.c          lapacke_shs_nancheck.c          lapacke_zhe_nancheck.c
-lapacke_che_nancheck.c          lapacke_dhs_trans.c             lapacke_shs_trans.c             lapacke_zhe_trans.c
-lapacke_che_trans.c             lapacke_dpb_nancheck.c          lapacke_spb_nancheck.c          lapacke_zhp_nancheck.c
-lapacke_chp_nancheck.c          lapacke_dpb_trans.c             lapacke_spb_trans.c             lapacke_zhp_trans.c
-lapacke_chp_trans.c             lapacke_dpf_nancheck.c          lapacke_spf_nancheck.c          lapacke_zhs_nancheck.c
-lapacke_chs_nancheck.c          lapacke_dpf_trans.c             lapacke_spf_trans.c             lapacke_zhs_trans.c
-lapacke_chs_trans.c             lapacke_dpo_nancheck.c          lapacke_spo_nancheck.c          lapacke_zpb_nancheck.c
-lapacke_cpb_nancheck.c          lapacke_dpo_trans.c             lapacke_spo_trans.c             lapacke_zpb_trans.c
-lapacke_cpb_trans.c             lapacke_dpp_nancheck.c          lapacke_spp_nancheck.c          lapacke_zpf_nancheck.c
-lapacke_cpf_nancheck.c          lapacke_dpp_trans.c             lapacke_spp_trans.c             lapacke_zpf_trans.c
-lapacke_cpf_trans.c             lapacke_dpt_nancheck.c          lapacke_spt_nancheck.c          lapacke_zpo_nancheck.c
-lapacke_cpo_nancheck.c          lapacke_dsb_nancheck.c          lapacke_ssb_nancheck.c          lapacke_zpo_trans.c
-lapacke_cpo_trans.c             lapacke_dsb_trans.c             lapacke_ssb_trans.c             lapacke_zpp_nancheck.c
-lapacke_cpp_nancheck.c          lapacke_dsp_nancheck.c          lapacke_ssp_nancheck.c          lapacke_zpp_trans.c
-lapacke_cpp_trans.c             lapacke_dsp_trans.c             lapacke_ssp_trans.c             lapacke_zpt_nancheck.c
-lapacke_cpt_nancheck.c          lapacke_dst_nancheck.c          lapacke_sst_nancheck.c          lapacke_zsp_nancheck.c
-lapacke_csp_nancheck.c          lapacke_dsy_nancheck.c          lapacke_ssy_nancheck.c          lapacke_zsp_trans.c
-lapacke_csp_trans.c             lapacke_dsy_trans.c             lapacke_ssy_trans.c             lapacke_zst_nancheck.c
-lapacke_cst_nancheck.c          lapacke_dtb_nancheck.c          lapacke_stb_nancheck.c          lapacke_zsy_nancheck.c
-lapacke_csy_nancheck.c          lapacke_dtb_trans.c             lapacke_stb_trans.c             lapacke_zsy_trans.c
-lapacke_csy_trans.c             lapacke_dtf_nancheck.c          lapacke_stf_nancheck.c          lapacke_ztb_nancheck.c
-lapacke_ctb_nancheck.c          lapacke_dtf_trans.c             lapacke_stf_trans.c             lapacke_ztb_trans.c
-lapacke_ctb_trans.c             lapacke_dtp_nancheck.c          lapacke_stp_nancheck.c          lapacke_ztf_nancheck.c
-lapacke_ctf_nancheck.c          lapacke_dtp_trans.c             lapacke_stp_trans.c             lapacke_ztf_trans.c
-lapacke_ctf_trans.c             lapacke_dtr_nancheck.c          lapacke_str_nancheck.c          lapacke_ztp_nancheck.c
-lapacke_ctp_nancheck.c          lapacke_dtr_trans.c             lapacke_str_trans.c             lapacke_ztp_trans.c
-lapacke_ctp_trans.c             lapacke_lsame.c                 lapacke_xerbla.c                lapacke_ztr_nancheck.c
-lapacke_ctr_nancheck.c          lapacke_make_complex_double.c   lapacke_z_nancheck.c            lapacke_ztr_trans.c
+lapacke_c_nancheck.c          lapacke_d_nancheck.c          lapacke_s_nancheck.c          lapacke_z_nancheck.c
+lapacke_cgb_nancheck.c        lapacke_dgb_nancheck.c        lapacke_sgb_nancheck.c        lapacke_zgb_trans.c
+lapacke_cgb_trans.c           lapacke_dgb_trans.c           lapacke_sgb_trans.c           lapacke_zgb_nancheck.c
+lapacke_cge_nancheck.c        lapacke_dge_nancheck.c        lapacke_sge_nancheck.c        lapacke_zge_nancheck.c
+lapacke_cge_trans.c           lapacke_dge_trans.c           lapacke_sge_trans.c           lapacke_zge_trans.c
+lapacke_cgg_nancheck.c        lapacke_dgg_nancheck.c        lapacke_sgg_nancheck.c        lapacke_zgg_nancheck.c
+lapacke_cgg_trans.c           lapacke_dgg_trans.c           lapacke_sgg_trans.c           lapacke_zgg_trans.c
+lapacke_cgt_nancheck.c        lapacke_dgt_nancheck.c        lapacke_sgt_nancheck.c        lapacke_zgt_nancheck.c
+lapacke_chb_nancheck.c        lapacke_dsb_nancheck.c        lapacke_ssb_nancheck.c        lapacke_zhb_nancheck.c
+lapacke_chb_trans.c           lapacke_dsb_trans.c           lapacke_ssb_trans.c           lapacke_zhb_trans.c
+lapacke_che_nancheck.c                                                                    lapacke_zhe_nancheck.c
+lapacke_che_trans.c                                                                       lapacke_zhe_trans.c
+lapacke_chp_nancheck.c                                                                    lapacke_zhp_nancheck.c
+lapacke_chp_trans.c                                                                       lapacke_zhp_trans.c
+lapacke_chs_nancheck.c        lapacke_dhs_nancheck.c        lapacke_shs_nancheck.c        lapacke_zhs_nancheck.c
+lapacke_chs_trans.c           lapacke_dhs_trans.c           lapacke_shs_trans.c           lapacke_zhs_trans.c
+lapacke_cpb_nancheck.c        lapacke_dpb_nancheck.c        lapacke_spb_nancheck.c        lapacke_zpb_nancheck.c
+lapacke_cpb_trans.c           lapacke_dpb_trans.c           lapacke_spb_trans.c           lapacke_zpb_trans.c
+lapacke_cpf_nancheck.c        lapacke_dpf_nancheck.c        lapacke_spf_nancheck.c        lapacke_zpf_nancheck.c
+lapacke_cpf_trans.c           lapacke_dpf_trans.c           lapacke_spf_trans.c           lapacke_zpf_trans.c
+lapacke_cpo_nancheck.c        lapacke_dpo_nancheck.c        lapacke_spo_nancheck.c        lapacke_zpo_nancheck.c
+lapacke_cpo_trans.c           lapacke_dpo_trans.c           lapacke_spo_trans.c           lapacke_zpo_trans.c
+lapacke_cpp_nancheck.c        lapacke_dpp_nancheck.c        lapacke_spp_nancheck.c        lapacke_zpp_nancheck.c
+lapacke_cpp_trans.c           lapacke_dpp_trans.c           lapacke_spp_trans.c           lapacke_zpp_trans.c
+lapacke_cpt_nancheck.c        lapacke_dpt_nancheck.c        lapacke_spt_nancheck.c        lapacke_zpt_nancheck.c
+lapacke_csp_nancheck.c        lapacke_dsp_nancheck.c        lapacke_ssp_nancheck.c        lapacke_zsp_nancheck.c
+lapacke_csp_trans.c           lapacke_dsp_trans.c           lapacke_ssp_trans.c           lapacke_zsp_trans.c
+lapacke_cst_nancheck.c        lapacke_dst_nancheck.c        lapacke_sst_nancheck.c        lapacke_zst_nancheck.c
+lapacke_csy_nancheck.c        lapacke_dsy_nancheck.c        lapacke_ssy_nancheck.c        lapacke_zsy_nancheck.c
+lapacke_csy_trans.c           lapacke_dsy_trans.c           lapacke_ssy_trans.c           lapacke_zsy_trans.c
+lapacke_ctb_nancheck.c        lapacke_dtb_nancheck.c        lapacke_stb_nancheck.c        lapacke_ztb_nancheck.c
+lapacke_ctb_trans.c           lapacke_dtb_trans.c           lapacke_stb_trans.c           lapacke_ztb_trans.c
+lapacke_ctf_nancheck.c        lapacke_dtf_nancheck.c        lapacke_stf_nancheck.c        lapacke_ztf_nancheck.c
+lapacke_ctf_trans.c           lapacke_dtf_trans.c           lapacke_stf_trans.c           lapacke_ztf_trans.c
+lapacke_ctp_nancheck.c        lapacke_dtp_nancheck.c        lapacke_stp_nancheck.c        lapacke_ztp_nancheck.c
+lapacke_ctp_trans.c           lapacke_dtp_trans.c           lapacke_stp_trans.c           lapacke_ztp_trans.c
+lapacke_ctr_nancheck.c        lapacke_dtr_nancheck.c        lapacke_str_nancheck.c        lapacke_ztr_nancheck.c
+lapacke_ctr_trans.c           lapacke_dtr_trans.c           lapacke_str_trans.c           lapacke_ztr_trans.c
+lapacke_ctz_nancheck.c        lapacke_dtz_nancheck.c        lapacke_stz_nancheck.c        lapacke_ztz_nancheck.c
+lapacke_ctz_trans.c           lapacke_dtz_trans.c           lapacke_stz_trans.c           lapacke_ztz_trans.c
+
+lapacke_make_complex_float.c                                                              lapacke_make_complex_double.c
+lapacke_lsame.c
+lapacke_xerbla.c
 )

lapack-netlib/LAPACKE/utils/Makefile

@@ -76,6 +76,8 @@ OBJ = lapacke_cgb_nancheck.o \
       lapacke_ctp_trans.o \
       lapacke_ctr_nancheck.o \
       lapacke_ctr_trans.o \
+      lapacke_ctz_nancheck.o \
+      lapacke_ctz_trans.o \
       lapacke_dgb_nancheck.o \
       lapacke_dgb_trans.o \
       lapacke_dge_nancheck.o \
@@ -110,6 +112,8 @@ OBJ = lapacke_cgb_nancheck.o \
       lapacke_dtp_trans.o \
       lapacke_dtr_nancheck.o \
       lapacke_dtr_trans.o \
+      lapacke_dtz_nancheck.o \
+      lapacke_dtz_trans.o \
       lapacke_lsame.o \
       lapacke_sgb_nancheck.o \
       lapacke_sgb_trans.o \
@@ -145,6 +149,8 @@ OBJ = lapacke_cgb_nancheck.o \
       lapacke_stp_trans.o \
       lapacke_str_nancheck.o \
       lapacke_str_trans.o \
+      lapacke_stz_nancheck.o \
+      lapacke_stz_trans.o \
       lapacke_xerbla.o \
       lapacke_zgb_nancheck.o \
       lapacke_zgb_trans.o \
@@ -184,6 +190,8 @@ OBJ = lapacke_cgb_nancheck.o \
       lapacke_ztp_trans.o \
       lapacke_ztr_nancheck.o \
       lapacke_ztr_trans.o \
+      lapacke_ztz_nancheck.o \
+      lapacke_ztz_trans.o \
       lapacke_make_complex_float.o \
       lapacke_make_complex_double.o
 

lapack-netlib/LAPACKE/utils/lapacke_ctz_nancheck.c

@@ -0,0 +1,144 @@
+/*****************************************************************************
+  Copyright (c) 2022, Intel Corp.
+  All rights reserved.
+
+  Redistribution and use in source and binary forms, with or without
+  modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright notice,
+      this list of conditions and the following disclaimer.
+    * Redistributions in binary form must reproduce the above copyright
+      notice, this list of conditions and the following disclaimer in the
+      documentation and/or other materials provided with the distribution.
+    * Neither the name of Intel Corporation nor the names of its contributors
+      may be used to endorse or promote products derived from this software
+      without specific prior written permission.
+
+  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+  AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+  IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+  ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+  LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+  CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+  SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+  INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+  CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+  ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
+  THE POSSIBILITY OF SUCH DAMAGE.
+******************************************************************************
+* Contents: Native C interface to LAPACK utility function
+* Author: Simon Märtens
+*****************************************************************************/
+
+#include "lapacke_utils.h"
+
+/*****************************************************************************
+  Check a trapezoidal matrix for NaN entries. The shape of the trapezoidal
+  matrix is determined by the arguments `direct` and `uplo`. `Direct` chooses
+  the diagonal which shall be considered and `uplo` tells us whether we use the
+  upper or lower part of the matrix with respect to the chosen diagonal.
+
+      Diagonals 'F' (front / forward) and 'B' (back / backward):
+
+        A = ( F       )           A = ( F     B       )
+            (    F    )               (    F     B    )
+            ( B     F )               (       F     B )
+            (    B    )
+            (       B )
+
+      direct = 'F', uplo = 'L':
+
+        A = ( *       )           A = ( *             )
+            ( *  *    )               ( *  *          )
+            ( *  *  * )               ( *  *  *       )
+            ( *  *  * )
+            ( *  *  * )
+
+      direct = 'F', uplo = 'U':
+
+        A = ( *  *  * )           A = ( *  *  *  *  * )
+            (    *  * )               (    *  *  *  * )
+            (       * )               (       *  *  * )
+            (         )
+            (         )
+
+      direct = 'B', uplo = 'L':
+
+        A = (         )           A = ( *  *  *       )
+            (         )               ( *  *  *  *    )
+            ( *       )               ( *  *  *  *  * )
+            ( *  *    )
+            ( *  *  * )
+
+      direct = 'B', uplo = 'U':
+
+        A = ( *  *  * )           A = (       *  *  * )
+            ( *  *  * )               (          *  * )
+            ( *  *  * )               (             * )
+            (    *  * )
+            (       * )
+
+*****************************************************************************/
+
+lapack_logical LAPACKE_ctz_nancheck( int matrix_layout, char direct, char uplo,
+                                     char diag, lapack_int m, lapack_int n,
+                                     const lapack_complex_float *a,
+                                     lapack_int lda )
+{
+    lapack_logical colmaj, front, lower, unit;
+
+    if( a == NULL ) return (lapack_logical) 0;
+
+    colmaj = ( matrix_layout == LAPACK_COL_MAJOR );
+    front  = LAPACKE_lsame( direct, 'f' );
+    lower  = LAPACKE_lsame( uplo, 'l' );
+    unit   = LAPACKE_lsame( diag, 'u' );
+
+    if( ( !colmaj && ( matrix_layout != LAPACK_ROW_MAJOR ) ) ||
+        ( !front  && !LAPACKE_lsame( direct, 'b' ) ) ||
+        ( !lower  && !LAPACKE_lsame( uplo, 'u' ) ) ||
+        ( !unit   && !LAPACKE_lsame( diag, 'n' ) ) ) {
+        /* Just exit if any of input parameters are wrong */
+        return (lapack_logical) 0;
+    }
+
+    /* Initial offsets and sizes of triangular and rectangular parts */
+    lapack_int tri_offset = 0;
+    lapack_int tri_n = MIN(m,n);
+    lapack_int rect_offset = -1;
+    lapack_int rect_m = ( m > n ) ? m - n : m;
+    lapack_int rect_n = ( n > m ) ? n - m : n;
+
+    /* Fix offsets depending on the shape of the matrix */
+    if( front ) {
+        if( lower && m > n ) {
+            rect_offset = tri_n * ( !colmaj ? lda : 1 );
+        } else if( !lower && n > m ) {
+            rect_offset = tri_n * ( colmaj ? lda : 1 );
+        }
+    } else {
+        if( m > n ) {
+            tri_offset = rect_m * ( !colmaj ? lda : 1 );
+            if( !lower ) {
+                rect_offset = 0;
+            }
+        } else if( n > m ) {
+            tri_offset = rect_n * ( colmaj ? lda : 1 );
+            if( lower ) {
+                rect_offset = 0;
+            }
+        }
+    }
+
+    /* Check rectangular part */
+    if( rect_offset >= 0 ) {
+        if( LAPACKE_cge_nancheck( matrix_layout, rect_m, rect_n,
+                                  &a[rect_offset], lda) ) {
+            return (lapack_logical) 1;
+        }
+    }
+
+    /* Check triangular part */
+    return LAPACKE_ctr_nancheck( matrix_layout, uplo, diag, tri_n,
+                                 &a[tri_offset], lda );
+}

lapack-netlib/LAPACKE/utils/lapacke_ctz_trans.c

@@ -0,0 +1,153 @@
+/*****************************************************************************
+  Copyright (c) 2022, Intel Corp.
+  All rights reserved.
+
+  Redistribution and use in source and binary forms, with or without
+  modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright notice,
+      this list of conditions and the following disclaimer.
+    * Redistributions in binary form must reproduce the above copyright
+      notice, this list of conditions and the following disclaimer in the
+      documentation and/or other materials provided with the distribution.
+    * Neither the name of Intel Corporation nor the names of its contributors
+      may be used to endorse or promote products derived from this software
+      without specific prior written permission.
+
+  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+  AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+  IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+  ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+  LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+  CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+  SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+  INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+  CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+  ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
+  THE POSSIBILITY OF SUCH DAMAGE.
+******************************************************************************
+* Contents: Native C interface to LAPACK utility function
+* Author: Simon Märtens
+*****************************************************************************/
+
+#include "lapacke_utils.h"
+
+/*****************************************************************************
+  Converts input triangular matrix from row-major(C) to column-major(Fortran)
+  layout or vice versa. The shape of the trapezoidal matrix is determined by
+  the arguments `direct` and `uplo`. `Direct` chooses the diagonal which shall
+  be considered and `uplo` tells us whether we use the upper or lower part of
+  the matrix with respect to the chosen diagonal.
+
+      Diagonals 'F' (front / forward) and 'B' (back / backward):
+
+        A = ( F       )           A = ( F     B       )
+            (    F    )               (    F     B    )
+            ( B     F )               (       F     B )
+            (    B    )
+            (       B )
+
+      direct = 'F', uplo = 'L':
+
+        A = ( *       )           A = ( *             )
+            ( *  *    )               ( *  *          )
+            ( *  *  * )               ( *  *  *       )
+            ( *  *  * )
+            ( *  *  * )
+
+      direct = 'F', uplo = 'U':
+
+        A = ( *  *  * )           A = ( *  *  *  *  * )
+            (    *  * )               (    *  *  *  * )
+            (       * )               (       *  *  * )
+            (         )
+            (         )
+
+      direct = 'B', uplo = 'L':
+
+        A = (         )           A = ( *  *  *       )
+            (         )               ( *  *  *  *    )
+            ( *       )               ( *  *  *  *  * )
+            ( *  *    )
+            ( *  *  * )
+
+      direct = 'B', uplo = 'U':
+
+        A = ( *  *  * )           A = (       *  *  * )
+            ( *  *  * )               (          *  * )
+            ( *  *  * )               (             * )
+            (    *  * )
+            (       * )
+
+*****************************************************************************/
+
+void LAPACKE_ctz_trans( int matrix_layout, char direct, char uplo,
+                        char diag, lapack_int m, lapack_int n,
+                        const lapack_complex_float *in, lapack_int ldin,
+                        lapack_complex_float *out, lapack_int ldout )
+{
+    lapack_logical colmaj, front, lower, unit;
+
+    if( in == NULL || out == NULL ) return ;
+
+    colmaj = ( matrix_layout == LAPACK_COL_MAJOR );
+    front  = LAPACKE_lsame( direct, 'f' );
+    lower  = LAPACKE_lsame( uplo, 'l' );
+    unit   = LAPACKE_lsame( diag, 'u' );
+
+    if( ( !colmaj && ( matrix_layout != LAPACK_ROW_MAJOR ) ) ||
+        ( !front  && !LAPACKE_lsame( direct, 'b' ) ) ||
+        ( !lower  && !LAPACKE_lsame( uplo, 'u' ) ) ||
+        ( !unit   && !LAPACKE_lsame( diag, 'n' ) ) ) {
+        /* Just exit if any of input parameters are wrong */
+        return;
+    }
+
+    /* Initial offsets and sizes of triangular and rectangular parts */
+    lapack_int tri_in_offset = 0;
+    lapack_int tri_out_offset = 0;
+    lapack_int tri_n = MIN(m,n);
+    lapack_int rect_in_offset = -1;
+    lapack_int rect_out_offset = -1;
+    lapack_int rect_m = ( m > n ) ? m - n : m;
+    lapack_int rect_n = ( n > m ) ? n - m : n;
+
+    /* Fix offsets depending on the shape of the matrix */
+    if( front ) {
+        if( lower && m > n ) {
+            rect_in_offset = tri_n * ( !colmaj ? ldin : 1 );
+            rect_out_offset = tri_n * ( colmaj ? ldout : 1 );
+        } else if( !lower && n > m ) {
+            rect_in_offset = tri_n * ( colmaj ? ldin : 1 );
+            rect_out_offset = tri_n * ( !colmaj ? ldout : 1 );
+        }
+    } else {
+        if( m > n ) {
+            tri_in_offset = rect_m * ( !colmaj ? ldin : 1 );
+            tri_out_offset = rect_m * ( colmaj ? ldout : 1 );
+            if( !lower ) {
+                rect_in_offset = 0;
+                rect_out_offset = 0;
+            }
+        } else if( n > m ) {
+            tri_in_offset = rect_n * ( colmaj ? ldin : 1 );
+            tri_out_offset = rect_n * ( !colmaj ? ldout : 1 );
+            if( lower ) {
+                rect_in_offset = 0;
+                rect_out_offset = 0;
+            }
+        }
+    }
+
+    /* Copy & transpose rectangular part */
+    if( rect_in_offset >= 0 && rect_out_offset >= 0 ) {
+        LAPACKE_cge_trans( matrix_layout, rect_m, rect_n,
+                           &in[rect_in_offset], ldin,
+                           &out[rect_out_offset], ldout );
+    }
+
+    /* Copy & transpose triangular part */
+    return LAPACKE_ctr_trans( matrix_layout, uplo, diag, tri_n,
+                              &in[tri_in_offset], ldin,
+                              &out[tri_out_offset], ldout );
+}

lapack-netlib/LAPACKE/utils/lapacke_dtz_nancheck.c

@@ -0,0 +1,143 @@
+/*****************************************************************************
+  Copyright (c) 2022, Intel Corp.
+  All rights reserved.
+
+  Redistribution and use in source and binary forms, with or without
+  modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright notice,
+      this list of conditions and the following disclaimer.
+    * Redistributions in binary form must reproduce the above copyright
+      notice, this list of conditions and the following disclaimer in the
+      documentation and/or other materials provided with the distribution.
+    * Neither the name of Intel Corporation nor the names of its contributors
+      may be used to endorse or promote products derived from this software
+      without specific prior written permission.
+
+  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+  AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+  IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+  ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+  LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+  CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+  SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+  INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+  CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+  ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
+  THE POSSIBILITY OF SUCH DAMAGE.
+******************************************************************************
+* Contents: Native C interface to LAPACK utility function
+* Author: Simon Märtens
+*****************************************************************************/
+
+#include "lapacke_utils.h"
+
+/*****************************************************************************
+  Check a trapezoidal matrix for NaN entries. The shape of the trapezoidal
+  matrix is determined by the arguments `direct` and `uplo`. `Direct` chooses
+  the diagonal which shall be considered and `uplo` tells us whether we use the
+  upper or lower part of the matrix with respect to the chosen diagonal.
+
+      Diagonals 'F' (front / forward) and 'B' (back / backward):
+
+        A = ( F       )           A = ( F     B       )
+            (    F    )               (    F     B    )
+            ( B     F )               (       F     B )
+            (    B    )
+            (       B )
+
+      direct = 'F', uplo = 'L':
+
+        A = ( *       )           A = ( *             )
+            ( *  *    )               ( *  *          )
+            ( *  *  * )               ( *  *  *       )
+            ( *  *  * )
+            ( *  *  * )
+
+      direct = 'F', uplo = 'U':
+
+        A = ( *  *  * )           A = ( *  *  *  *  * )
+            (    *  * )               (    *  *  *  * )
+            (       * )               (       *  *  * )
+            (         )
+            (         )
+
+      direct = 'B', uplo = 'L':
+
+        A = (         )           A = ( *  *  *       )
+            (         )               ( *  *  *  *    )
+            ( *       )               ( *  *  *  *  * )
+            ( *  *    )
+            ( *  *  * )
+
+      direct = 'B', uplo = 'U':
+
+        A = ( *  *  * )           A = (       *  *  * )
+            ( *  *  * )               (          *  * )
+            ( *  *  * )               (             * )
+            (    *  * )
+            (       * )
+
+*****************************************************************************/
+
+lapack_logical LAPACKE_dtz_nancheck( int matrix_layout, char direct, char uplo,
+                                     char diag, lapack_int m, lapack_int n,
+                                     const double *a, lapack_int lda )
+{
+    lapack_logical colmaj, front, lower, unit;
+
+    if( a == NULL ) return (lapack_logical) 0;
+
+    colmaj = ( matrix_layout == LAPACK_COL_MAJOR );
+    front  = LAPACKE_lsame( direct, 'f' );
+    lower  = LAPACKE_lsame( uplo, 'l' );
+    unit   = LAPACKE_lsame( diag, 'u' );
+
+    if( ( !colmaj && ( matrix_layout != LAPACK_ROW_MAJOR ) ) ||
+        ( !front  && !LAPACKE_lsame( direct, 'b' ) ) ||
+        ( !lower  && !LAPACKE_lsame( uplo, 'u' ) ) ||
+        ( !unit   && !LAPACKE_lsame( diag, 'n' ) ) ) {
+        /* Just exit if any of input parameters are wrong */
+        return (lapack_logical) 0;
+    }
+
+    /* Initial offsets and sizes of triangular and rectangular parts */
+    lapack_int tri_offset = 0;
+    lapack_int tri_n = MIN(m,n);
+    lapack_int rect_offset = -1;
+    lapack_int rect_m = ( m > n ) ? m - n : m;
+    lapack_int rect_n = ( n > m ) ? n - m : n;
+
+    /* Fix offsets depending on the shape of the matrix */
+    if( front ) {
+        if( lower && m > n ) {
+            rect_offset = tri_n * ( !colmaj ? lda : 1 );
+        } else if( !lower && n > m ) {
+            rect_offset = tri_n * ( colmaj ? lda : 1 );
+        }
+    } else {
+        if( m > n ) {
+            tri_offset = rect_m * ( !colmaj ? lda : 1 );
+            if( !lower ) {
+                rect_offset = 0;
+            }
+        } else if( n > m ) {
+            tri_offset = rect_n * ( colmaj ? lda : 1 );
+            if( lower ) {
+                rect_offset = 0;
+            }
+        }
+    }
+
+    /* Check rectangular part */
+    if( rect_offset >= 0 ) {
+        if( LAPACKE_dge_nancheck( matrix_layout, rect_m, rect_n,
+                                  &a[rect_offset], lda ) ) {
+            return (lapack_logical) 1;
+        }
+    }
+
+    /* Check triangular part */
+    return LAPACKE_dtr_nancheck( matrix_layout, uplo, diag, tri_n,
+                                 &a[tri_offset], lda );
+}

lapack-netlib/LAPACKE/utils/lapacke_dtz_trans.c

@@ -0,0 +1,153 @@
+/*****************************************************************************
+  Copyright (c) 2022, Intel Corp.
+  All rights reserved.
+
+  Redistribution and use in source and binary forms, with or without
+  modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright notice,
+      this list of conditions and the following disclaimer.
+    * Redistributions in binary form must reproduce the above copyright
+      notice, this list of conditions and the following disclaimer in the
+      documentation and/or other materials provided with the distribution.
+    * Neither the name of Intel Corporation nor the names of its contributors
+      may be used to endorse or promote products derived from this software
+      without specific prior written permission.
+
+  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+  AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+  IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+  ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+  LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+  CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+  SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+  INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+  CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+  ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
+  THE POSSIBILITY OF SUCH DAMAGE.
+******************************************************************************
+* Contents: Native C interface to LAPACK utility function
+* Author: Simon Märtens
+*****************************************************************************/
+
+#include "lapacke_utils.h"
+
+/*****************************************************************************
+  Converts input triangular matrix from row-major(C) to column-major(Fortran)
+  layout or vice versa. The shape of the trapezoidal matrix is determined by
+  the arguments `direct` and `uplo`. `Direct` chooses the diagonal which shall
+  be considered and `uplo` tells us whether we use the upper or lower part of
+  the matrix with respect to the chosen diagonal.
+
+      Diagonals 'F' (front / forward) and 'B' (back / backward):
+
+        A = ( F       )           A = ( F     B       )
+            (    F    )               (    F     B    )
+            ( B     F )               (       F     B )
+            (    B    )
+            (       B )
+
+      direct = 'F', uplo = 'L':
+
+        A = ( *       )           A = ( *             )
+            ( *  *    )               ( *  *          )
+            ( *  *  * )               ( *  *  *       )
+            ( *  *  * )
+            ( *  *  * )
+
+      direct = 'F', uplo = 'U':
+
+        A = ( *  *  * )           A = ( *  *  *  *  * )
+            (    *  * )               (    *  *  *  * )
+            (       * )               (       *  *  * )
+            (         )
+            (         )
+
+      direct = 'B', uplo = 'L':
+
+        A = (         )           A = ( *  *  *       )
+            (         )               ( *  *  *  *    )
+            ( *       )               ( *  *  *  *  * )
+            ( *  *    )
+            ( *  *  * )
+
+      direct = 'B', uplo = 'U':
+
+        A = ( *  *  * )           A = (       *  *  * )
+            ( *  *  * )               (          *  * )
+            ( *  *  * )               (             * )
+            (    *  * )
+            (       * )
+
+*****************************************************************************/
+
+void LAPACKE_dtz_trans( int matrix_layout, char direct, char uplo,
+                        char diag, lapack_int m, lapack_int n,
+                        const double *in, lapack_int ldin,
+                        double *out, lapack_int ldout )
+{
+    lapack_logical colmaj, front, lower, unit;
+
+    if( in == NULL || out == NULL ) return ;
+
+    colmaj = ( matrix_layout == LAPACK_COL_MAJOR );
+    front  = LAPACKE_lsame( direct, 'f' );
+    lower  = LAPACKE_lsame( uplo, 'l' );
+    unit   = LAPACKE_lsame( diag, 'u' );
+
+    if( ( !colmaj && ( matrix_layout != LAPACK_ROW_MAJOR ) ) ||
+        ( !front  && !LAPACKE_lsame( direct, 'b' ) ) ||
+        ( !lower  && !LAPACKE_lsame( uplo, 'u' ) ) ||
+        ( !unit   && !LAPACKE_lsame( diag, 'n' ) ) ) {
+        /* Just exit if any of input parameters are wrong */
+        return;
+    }
+
+    /* Initial offsets and sizes of triangular and rectangular parts */
+    lapack_int tri_in_offset = 0;
+    lapack_int tri_out_offset = 0;
+    lapack_int tri_n = MIN(m,n);
+    lapack_int rect_in_offset = -1;
+    lapack_int rect_out_offset = -1;
+    lapack_int rect_m = ( m > n ) ? m - n : m;
+    lapack_int rect_n = ( n > m ) ? n - m : n;
+
+    /* Fix offsets depending on the shape of the matrix */
+    if( front ) {
+        if( lower && m > n ) {
+            rect_in_offset = tri_n * ( !colmaj ? ldin : 1 );
+            rect_out_offset = tri_n * ( colmaj ? ldout : 1 );
+        } else if( !lower && n > m ) {
+            rect_in_offset = tri_n * ( colmaj ? ldin : 1 );
+            rect_out_offset = tri_n * ( !colmaj ? ldout : 1 );
+        }
+    } else {
+        if( m > n ) {
+            tri_in_offset = rect_m * ( !colmaj ? ldin : 1 );
+            tri_out_offset = rect_m * ( colmaj ? ldout : 1 );
+            if( !lower ) {
+                rect_in_offset = 0;
+                rect_out_offset = 0;
+            }
+        } else if( n > m ) {
+            tri_in_offset = rect_n * ( colmaj ? ldin : 1 );
+            tri_out_offset = rect_n * ( !colmaj ? ldout : 1 );
+            if( lower ) {
+                rect_in_offset = 0;
+                rect_out_offset = 0;
+            }
+        }
+    }
+
+    /* Copy & transpose rectangular part */
+    if( rect_in_offset >= 0 && rect_out_offset >= 0 ) {
+        LAPACKE_dge_trans( matrix_layout, rect_m, rect_n,
+                           &in[rect_in_offset], ldin,
+                           &out[rect_out_offset], ldout );
+    }
+
+    /* Copy & transpose triangular part */
+    return LAPACKE_dtr_trans( matrix_layout, uplo, diag, tri_n,
+                              &in[tri_in_offset], ldin,
+                              &out[tri_out_offset], ldout );
+}

lapack-netlib/LAPACKE/utils/lapacke_stz_nancheck.c

@@ -0,0 +1,143 @@
+/*****************************************************************************
+  Copyright (c) 2022, Intel Corp.
+  All rights reserved.
+
+  Redistribution and use in source and binary forms, with or without
+  modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright notice,
+      this list of conditions and the following disclaimer.
+    * Redistributions in binary form must reproduce the above copyright
+      notice, this list of conditions and the following disclaimer in the
+      documentation and/or other materials provided with the distribution.
+    * Neither the name of Intel Corporation nor the names of its contributors
+      may be used to endorse or promote products derived from this software
+      without specific prior written permission.
+
+  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+  AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+  IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+  ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+  LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+  CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+  SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+  INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+  CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+  ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
+  THE POSSIBILITY OF SUCH DAMAGE.
+******************************************************************************
+* Contents: Native C interface to LAPACK utility function
+* Author: Simon Märtens
+*****************************************************************************/
+
+#include "lapacke_utils.h"
+
+/*****************************************************************************
+  Check a trapezoidal matrix for NaN entries. The shape of the trapezoidal
+  matrix is determined by the arguments `direct` and `uplo`. `Direct` chooses
+  the diagonal which shall be considered and `uplo` tells us whether we use the
+  upper or lower part of the matrix with respect to the chosen diagonal.
+
+      Diagonals 'F' (front / forward) and 'B' (back / backward):
+
+        A = ( F       )           A = ( F     B       )
+            (    F    )               (    F     B    )
+            ( B     F )               (       F     B )
+            (    B    )
+            (       B )
+
+      direct = 'F', uplo = 'L':
+
+        A = ( *       )           A = ( *             )
+            ( *  *    )               ( *  *          )
+            ( *  *  * )               ( *  *  *       )
+            ( *  *  * )
+            ( *  *  * )
+
+      direct = 'F', uplo = 'U':
+
+        A = ( *  *  * )           A = ( *  *  *  *  * )
+            (    *  * )               (    *  *  *  * )
+            (       * )               (       *  *  * )
+            (         )
+            (         )
+
+      direct = 'B', uplo = 'L':
+
+        A = (         )           A = ( *  *  *       )
+            (         )               ( *  *  *  *    )
+            ( *       )               ( *  *  *  *  * )
+            ( *  *    )
+            ( *  *  * )
+
+      direct = 'B', uplo = 'U':
+
+        A = ( *  *  * )           A = (       *  *  * )
+            ( *  *  * )               (          *  * )
+            ( *  *  * )               (             * )
+            (    *  * )
+            (       * )
+
+*****************************************************************************/
+
+lapack_logical LAPACKE_stz_nancheck( int matrix_layout, char direct, char uplo,
+                                     char diag, lapack_int m, lapack_int n,
+                                     const float *a, lapack_int lda )
+{
+    lapack_logical colmaj, front, lower, unit;
+
+    if( a == NULL ) return (lapack_logical) 0;
+
+    colmaj = ( matrix_layout == LAPACK_COL_MAJOR );
+    front  = LAPACKE_lsame( direct, 'f' );
+    lower  = LAPACKE_lsame( uplo, 'l' );
+    unit   = LAPACKE_lsame( diag, 'u' );
+
+    if( ( !colmaj && ( matrix_layout != LAPACK_ROW_MAJOR ) ) ||
+        ( !front  && !LAPACKE_lsame( direct, 'b' ) ) ||
+        ( !lower  && !LAPACKE_lsame( uplo, 'u' ) ) ||
+        ( !unit   && !LAPACKE_lsame( diag, 'n' ) ) ) {
+        /* Just exit if any of input parameters are wrong */
+        return (lapack_logical) 0;
+    }
+
+    /* Initial offsets and sizes of triangular and rectangular parts */
+    lapack_int tri_offset = 0;
+    lapack_int tri_n = MIN(m,n);
+    lapack_int rect_offset = -1;
+    lapack_int rect_m = ( m > n ) ? m - n : m;
+    lapack_int rect_n = ( n > m ) ? n - m : n;
+
+    /* Fix offsets depending on the shape of the matrix */
+    if( front ) {
+        if( lower && m > n ) {
+            rect_offset = tri_n * ( !colmaj ? lda : 1 );
+        } else if( !lower && n > m ) {
+            rect_offset = tri_n * ( colmaj ? lda : 1 );
+        }
+    } else {
+        if( m > n ) {
+            tri_offset = rect_m * ( !colmaj ? lda : 1 );
+            if( !lower ) {
+                rect_offset = 0;
+            }
+        } else if( n > m ) {
+            tri_offset = rect_n * ( colmaj ? lda : 1 );
+            if( lower ) {
+                rect_offset = 0;
+            }
+        }
+    }
+
+    /* Check rectangular part */
+    if( rect_offset >= 0 ) {
+        if( LAPACKE_sge_nancheck( matrix_layout, rect_m, rect_n,
+                                  &a[rect_offset], lda) ) {
+            return (lapack_logical) 1;
+        }
+    }
+
+    /* Check triangular part */
+    return LAPACKE_str_nancheck( matrix_layout, uplo, diag, tri_n,
+                                 &a[tri_offset], lda );
+}

lapack-netlib/LAPACKE/utils/lapacke_stz_trans.c

@@ -0,0 +1,153 @@
+/*****************************************************************************
+  Copyright (c) 2022, Intel Corp.
+  All rights reserved.
+
+  Redistribution and use in source and binary forms, with or without
+  modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright notice,
+      this list of conditions and the following disclaimer.
+    * Redistributions in binary form must reproduce the above copyright
+      notice, this list of conditions and the following disclaimer in the
+      documentation and/or other materials provided with the distribution.
+    * Neither the name of Intel Corporation nor the names of its contributors
+      may be used to endorse or promote products derived from this software
+      without specific prior written permission.
+
+  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+  AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+  IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+  ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+  LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+  CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+  SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+  INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+  CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+  ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
+  THE POSSIBILITY OF SUCH DAMAGE.
+******************************************************************************
+* Contents: Native C interface to LAPACK utility function
+* Author: Simon Märtens
+*****************************************************************************/
+
+#include "lapacke_utils.h"
+
+/*****************************************************************************
+  Converts input triangular matrix from row-major(C) to column-major(Fortran)
+  layout or vice versa. The shape of the trapezoidal matrix is determined by
+  the arguments `direct` and `uplo`. `Direct` chooses the diagonal which shall
+  be considered and `uplo` tells us whether we use the upper or lower part of
+  the matrix with respect to the chosen diagonal.
+
+      Diagonals 'F' (front / forward) and 'B' (back / backward):
+
+        A = ( F       )           A = ( F     B       )
+            (    F    )               (    F     B    )
+            ( B     F )               (       F     B )
+            (    B    )
+            (       B )
+
+      direct = 'F', uplo = 'L':
+
+        A = ( *       )           A = ( *             )
+            ( *  *    )               ( *  *          )
+            ( *  *  * )               ( *  *  *       )
+            ( *  *  * )
+            ( *  *  * )
+
+      direct = 'F', uplo = 'U':
+
+        A = ( *  *  * )           A = ( *  *  *  *  * )
+            (    *  * )               (    *  *  *  * )
+            (       * )               (       *  *  * )
+            (         )
+            (         )
+
+      direct = 'B', uplo = 'L':
+
+        A = (         )           A = ( *  *  *       )
+            (         )               ( *  *  *  *    )
+            ( *       )               ( *  *  *  *  * )
+            ( *  *    )
+            ( *  *  * )
+
+      direct = 'B', uplo = 'U':
+
+        A = ( *  *  * )           A = (       *  *  * )
+            ( *  *  * )               (          *  * )
+            ( *  *  * )               (             * )
+            (    *  * )
+            (       * )
+
+*****************************************************************************/
+
+void LAPACKE_stz_trans( int matrix_layout, char direct, char uplo,
+                        char diag, lapack_int m, lapack_int n,
+                        const float *in, lapack_int ldin,
+                        float *out, lapack_int ldout )
+{
+    lapack_logical colmaj, front, lower, unit;
+
+    if( in == NULL || out == NULL ) return ;
+
+    colmaj = ( matrix_layout == LAPACK_COL_MAJOR );
+    front  = LAPACKE_lsame( direct, 'f' );
+    lower  = LAPACKE_lsame( uplo, 'l' );
+    unit   = LAPACKE_lsame( diag, 'u' );
+
+    if( ( !colmaj && ( matrix_layout != LAPACK_ROW_MAJOR ) ) ||
+        ( !front  && !LAPACKE_lsame( direct, 'b' ) ) ||
+        ( !lower  && !LAPACKE_lsame( uplo, 'u' ) ) ||
+        ( !unit   && !LAPACKE_lsame( diag, 'n' ) ) ) {
+        /* Just exit if any of input parameters are wrong */
+        return;
+    }
+
+    /* Initial offsets and sizes of triangular and rectangular parts */
+    lapack_int tri_in_offset = 0;
+    lapack_int tri_out_offset = 0;
+    lapack_int tri_n = MIN(m,n);
+    lapack_int rect_in_offset = -1;
+    lapack_int rect_out_offset = -1;
+    lapack_int rect_m = ( m > n ) ? m - n : m;
+    lapack_int rect_n = ( n > m ) ? n - m : n;
+
+    /* Fix offsets depending on the shape of the matrix */
+    if( front ) {
+        if( lower && m > n ) {
+            rect_in_offset = tri_n * ( !colmaj ? ldin : 1 );
+            rect_out_offset = tri_n * ( colmaj ? ldout : 1 );
+        } else if( !lower && n > m ) {
+            rect_in_offset = tri_n * ( colmaj ? ldin : 1 );
+            rect_out_offset = tri_n * ( !colmaj ? ldout : 1 );
+        }
+    } else {
+        if( m > n ) {
+            tri_in_offset = rect_m * ( !colmaj ? ldin : 1 );
+            tri_out_offset = rect_m * ( colmaj ? ldout : 1 );
+            if( !lower ) {
+                rect_in_offset = 0;
+                rect_out_offset = 0;
+            }
+        } else if( n > m ) {
+            tri_in_offset = rect_n * ( colmaj ? ldin : 1 );
+            tri_out_offset = rect_n * ( !colmaj ? ldout : 1 );
+            if( lower ) {
+                rect_in_offset = 0;
+                rect_out_offset = 0;
+            }
+        }
+    }
+
+    /* Copy & transpose rectangular part */
+    if( rect_in_offset >= 0 && rect_out_offset >= 0 ) {
+        LAPACKE_sge_trans( matrix_layout, rect_m, rect_n,
+                           &in[rect_in_offset], ldin,
+                           &out[rect_out_offset], ldout );
+    }
+
+    /* Copy & transpose triangular part */
+    return LAPACKE_str_trans( matrix_layout, uplo, diag, tri_n,
+                              &in[tri_in_offset], ldin,
+                              &out[tri_out_offset], ldout );
+}

lapack-netlib/LAPACKE/utils/lapacke_ztz_nancheck.c

@@ -0,0 +1,144 @@
+/*****************************************************************************
+  Copyright (c) 2022, Intel Corp.
+  All rights reserved.
+
+  Redistribution and use in source and binary forms, with or without
+  modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright notice,
+      this list of conditions and the following disclaimer.
+    * Redistributions in binary form must reproduce the above copyright
+      notice, this list of conditions and the following disclaimer in the
+      documentation and/or other materials provided with the distribution.
+    * Neither the name of Intel Corporation nor the names of its contributors
+      may be used to endorse or promote products derived from this software
+      without specific prior written permission.
+
+  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+  AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+  IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+  ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+  LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+  CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+  SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+  INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+  CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+  ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
+  THE POSSIBILITY OF SUCH DAMAGE.
+******************************************************************************
+* Contents: Native C interface to LAPACK utility function
+* Author: Simon Märtens
+*****************************************************************************/
+
+#include "lapacke_utils.h"
+
+/*****************************************************************************
+  Check a trapezoidal matrix for NaN entries. The shape of the trapezoidal
+  matrix is determined by the arguments `direct` and `uplo`. `Direct` chooses
+  the diagonal which shall be considered and `uplo` tells us whether we use the
+  upper or lower part of the matrix with respect to the chosen diagonal.
+
+      Diagonals 'F' (front / forward) and 'B' (back / backward):
+
+        A = ( F       )           A = ( F     B       )
+            (    F    )               (    F     B    )
+            ( B     F )               (       F     B )
+            (    B    )
+            (       B )
+
+      direct = 'F', uplo = 'L':
+
+        A = ( *       )           A = ( *             )
+            ( *  *    )               ( *  *          )
+            ( *  *  * )               ( *  *  *       )
+            ( *  *  * )
+            ( *  *  * )
+
+      direct = 'F', uplo = 'U':
+
+        A = ( *  *  * )           A = ( *  *  *  *  * )
+            (    *  * )               (    *  *  *  * )
+            (       * )               (       *  *  * )
+            (         )
+            (         )
+
+      direct = 'B', uplo = 'L':
+
+        A = (         )           A = ( *  *  *       )
+            (         )               ( *  *  *  *    )
+            ( *       )               ( *  *  *  *  * )
+            ( *  *    )
+            ( *  *  * )
+
+      direct = 'B', uplo = 'U':
+
+        A = ( *  *  * )           A = (       *  *  * )
+            ( *  *  * )               (          *  * )
+            ( *  *  * )               (             * )
+            (    *  * )
+            (       * )
+
+*****************************************************************************/
+
+lapack_logical LAPACKE_ztz_nancheck( int matrix_layout, char direct, char uplo,
+                                     char diag, lapack_int m, lapack_int n,
+                                     const lapack_complex_double *a,
+                                     lapack_int lda )
+{
+    lapack_logical colmaj, front, lower, unit;
+
+    if( a == NULL ) return (lapack_logical) 0;
+
+    colmaj = ( matrix_layout == LAPACK_COL_MAJOR );
+    front  = LAPACKE_lsame( direct, 'f' );
+    lower  = LAPACKE_lsame( uplo, 'l' );
+    unit   = LAPACKE_lsame( diag, 'u' );
+
+    if( ( !colmaj && ( matrix_layout != LAPACK_ROW_MAJOR ) ) ||
+        ( !front  && !LAPACKE_lsame( direct, 'b' ) ) ||
+        ( !lower  && !LAPACKE_lsame( uplo, 'u' ) ) ||
+        ( !unit   && !LAPACKE_lsame( diag, 'n' ) ) ) {
+        /* Just exit if any of input parameters are wrong */
+        return (lapack_logical) 0;
+    }
+
+    /* Initial offsets and sizes of triangular and rectangular parts */
+    lapack_int tri_offset = 0;
+    lapack_int tri_n = MIN(m,n);
+    lapack_int rect_offset = -1;
+    lapack_int rect_m = ( m > n ) ? m - n : m;
+    lapack_int rect_n = ( n > m ) ? n - m : n;
+
+    /* Fix offsets depending on the shape of the matrix */
+    if( front ) {
+        if( lower && m > n ) {
+            rect_offset = tri_n * ( !colmaj ? lda : 1 );
+        } else if( !lower && n > m ) {
+            rect_offset = tri_n * ( colmaj ? lda : 1 );
+        }
+    } else {
+        if( m > n ) {
+            tri_offset = rect_m * ( !colmaj ? lda : 1 );
+            if( !lower ) {
+                rect_offset = 0;
+            }
+        } else if( n > m ) {
+            tri_offset = rect_n * ( colmaj ? lda : 1 );
+            if( lower ) {
+                rect_offset = 0;
+            }
+        }
+    }
+
+    /* Check rectangular part */
+    if( rect_offset >= 0 ) {
+        if( LAPACKE_zge_nancheck( matrix_layout, rect_m, rect_n,
+                                  &a[rect_offset], lda) ) {
+            return (lapack_logical) 1;
+        }
+    }
+
+    /* Check triangular part */
+    return LAPACKE_ztr_nancheck( matrix_layout, uplo, diag, tri_n,
+                                 &a[tri_offset], lda );
+}

lapack-netlib/LAPACKE/utils/lapacke_ztz_trans.c

@@ -0,0 +1,153 @@
+/*****************************************************************************
+  Copyright (c) 2022, Intel Corp.
+  All rights reserved.
+
+  Redistribution and use in source and binary forms, with or without
+  modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright notice,
+      this list of conditions and the following disclaimer.
+    * Redistributions in binary form must reproduce the above copyright
+      notice, this list of conditions and the following disclaimer in the
+      documentation and/or other materials provided with the distribution.
+    * Neither the name of Intel Corporation nor the names of its contributors
+      may be used to endorse or promote products derived from this software
+      without specific prior written permission.
+
+  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+  AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+  IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+  ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+  LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+  CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+  SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+  INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+  CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+  ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
+  THE POSSIBILITY OF SUCH DAMAGE.
+******************************************************************************
+* Contents: Native C interface to LAPACK utility function
+* Author: Simon Märtens
+*****************************************************************************/
+
+#include "lapacke_utils.h"
+
+/*****************************************************************************
+  Converts input triangular matrix from row-major(C) to column-major(Fortran)
+  layout or vice versa. The shape of the trapezoidal matrix is determined by
+  the arguments `direct` and `uplo`. `Direct` chooses the diagonal which shall
+  be considered and `uplo` tells us whether we use the upper or lower part of
+  the matrix with respect to the chosen diagonal.
+
+      Diagonals 'F' (front / forward) and 'B' (back / backward):
+
+        A = ( F       )           A = ( F     B       )
+            (    F    )               (    F     B    )
+            ( B     F )               (       F     B )
+            (    B    )
+            (       B )
+
+      direct = 'F', uplo = 'L':
+
+        A = ( *       )           A = ( *             )
+            ( *  *    )               ( *  *          )
+            ( *  *  * )               ( *  *  *       )
+            ( *  *  * )
+            ( *  *  * )
+
+      direct = 'F', uplo = 'U':
+
+        A = ( *  *  * )           A = ( *  *  *  *  * )
+            (    *  * )               (    *  *  *  * )
+            (       * )               (       *  *  * )
+            (         )
+            (         )
+
+      direct = 'B', uplo = 'L':
+
+        A = (         )           A = ( *  *  *       )
+            (         )               ( *  *  *  *    )
+            ( *       )               ( *  *  *  *  * )
+            ( *  *    )
+            ( *  *  * )
+
+      direct = 'B', uplo = 'U':
+
+        A = ( *  *  * )           A = (       *  *  * )
+            ( *  *  * )               (          *  * )
+            ( *  *  * )               (             * )
+            (    *  * )
+            (       * )
+
+*****************************************************************************/
+
+void LAPACKE_ztz_trans( int matrix_layout, char direct, char uplo,
+                        char diag, lapack_int m, lapack_int n,
+                        const lapack_complex_double *in, lapack_int ldin,
+                        lapack_complex_double *out, lapack_int ldout )
+{
+    lapack_logical colmaj, front, lower, unit;
+
+    if( in == NULL || out == NULL ) return ;
+
+    colmaj = ( matrix_layout == LAPACK_COL_MAJOR );
+    front  = LAPACKE_lsame( direct, 'f' );
+    lower  = LAPACKE_lsame( uplo, 'l' );
+    unit   = LAPACKE_lsame( diag, 'u' );
+
+    if( ( !colmaj && ( matrix_layout != LAPACK_ROW_MAJOR ) ) ||
+        ( !front  && !LAPACKE_lsame( direct, 'b' ) ) ||
+        ( !lower  && !LAPACKE_lsame( uplo, 'u' ) ) ||
+        ( !unit   && !LAPACKE_lsame( diag, 'n' ) ) ) {
+        /* Just exit if any of input parameters are wrong */
+        return;
+    }
+
+    /* Initial offsets and sizes of triangular and rectangular parts */
+    lapack_int tri_in_offset = 0;
+    lapack_int tri_out_offset = 0;
+    lapack_int tri_n = MIN(m,n);
+    lapack_int rect_in_offset = -1;
+    lapack_int rect_out_offset = -1;
+    lapack_int rect_m = ( m > n ) ? m - n : m;
+    lapack_int rect_n = ( n > m ) ? n - m : n;
+
+    /* Fix offsets depending on the shape of the matrix */
+    if( front ) {
+        if( lower && m > n ) {
+            rect_in_offset = tri_n * ( !colmaj ? ldin : 1 );
+            rect_out_offset = tri_n * ( colmaj ? ldout : 1 );
+        } else if( !lower && n > m ) {
+            rect_in_offset = tri_n * ( colmaj ? ldin : 1 );
+            rect_out_offset = tri_n * ( !colmaj ? ldout : 1 );
+        }
+    } else {
+        if( m > n ) {
+            tri_in_offset = rect_m * ( !colmaj ? ldin : 1 );
+            tri_out_offset = rect_m * ( colmaj ? ldout : 1 );
+            if( !lower ) {
+                rect_in_offset = 0;
+                rect_out_offset = 0;
+            }
+        } else if( n > m ) {
+            tri_in_offset = rect_n * ( colmaj ? ldin : 1 );
+            tri_out_offset = rect_n * ( !colmaj ? ldout : 1 );
+            if( lower ) {
+                rect_in_offset = 0;
+                rect_out_offset = 0;
+            }
+        }
+    }
+
+    /* Copy & transpose rectangular part */
+    if( rect_in_offset >= 0 && rect_out_offset >= 0 ) {
+        LAPACKE_zge_trans( matrix_layout, rect_m, rect_n,
+                           &in[rect_in_offset], ldin,
+                           &out[rect_out_offset], ldout );
+    }
+
+    /* Copy & transpose triangular part */
+    return LAPACKE_ztr_trans( matrix_layout, uplo, diag, tri_n,
+                              &in[tri_in_offset], ldin,
+                              &out[tri_out_offset], ldout );
+}