Skip to content

Commit a7e0724

Browse files
STCE2023STCE2023
committed
Used trapezoidal NaN check in LAPACKE_?larfb
1 parent 17f99f2 commit a7e0724

File tree

4 files changed

+72
-192
lines changed

4 files changed

+72
-192
lines changed

‎LAPACKE/src/lapacke_clarfb.c

Lines changed: 18 additions & 48 deletions
Original file line numberDiff line numberDiff line change
@@ -43,66 +43,36 @@ lapack_int LAPACKE_clarfb( int matrix_layout, char side, char trans, char direct
4343
lapack_int ldwork;
4444
lapack_complex_float* work = NULL;
4545
lapack_int ncols_v, nrows_v;
46+
lapack_logical left, col, forward;
47+
char uplo;
4648
if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
4749
LAPACKE_xerbla( "LAPACKE_clarfb", -1 );
4850
return -1;
4951
}
5052
#ifndef LAPACK_DISABLE_NAN_CHECK
5153
if( LAPACKE_get_nancheck() ) {
5254
/* Optionally check input matrices for NaNs */
53-
lapack_int lrv, lcv; /* row, column stride */
54-
if( matrix_layout == LAPACK_COL_MAJOR ) {
55-
lrv = 1;
56-
lcv = ldv;
57-
} else {
58-
lrv = ldv;
59-
lcv = 1;
60-
}
61-
ncols_v = LAPACKE_lsame( storev, 'c' ) ? k :
62-
( ( LAPACKE_lsame( storev, 'r' ) && LAPACKE_lsame( side, 'l' ) ) ? m :
63-
( ( LAPACKE_lsame( storev, 'r' ) && LAPACKE_lsame( side, 'r' ) ) ? n : 1) );
55+
left = LAPACKE_lsame( side, 'l' );
56+
col = LAPACKE_lsame( storev, 'c' );
57+
forward = LAPACKE_lsame( direct, 'f' );
6458

65-
nrows_v = ( LAPACKE_lsame( storev, 'c' ) && LAPACKE_lsame( side, 'l' ) ) ? m :
66-
( ( LAPACKE_lsame( storev, 'c' ) && LAPACKE_lsame( side, 'r' ) ) ? n :
67-
( LAPACKE_lsame( storev, 'r' ) ? k : 1) );
68-
if( LAPACKE_cge_nancheck( matrix_layout, m, n, c, ldc ) ) {
69-
return -13;
59+
ncols_v = ( !col && left ) ? m : ( ( !col && !left ) ? n : ( col ? k : 1 ) );
60+
nrows_v = ( col && left ) ? m : ( ( col && !left ) ? n : ( !col ? k : 1) );
61+
uplo = ( ( left && col ) || !( left || col ) ) ? 'l' : 'u';
62+
63+
if( !forward && ( col && k > nrows_v ) || ( !col && k > ncols_v )) {
64+
LAPACKE_xerbla( "LAPACKE_clarfb", -8 );
65+
return -8;
66+
}
67+
if( LAPACKE_ctz_nancheck( matrix_layout, direct, uplo, 'u',
68+
ncols_v, nrows_v, v, ldv ) ) {
69+
return -9;
7070
}
7171
if( LAPACKE_cge_nancheck( matrix_layout, k, k, t, ldt ) ) {
7272
return -11;
7373
}
74-
if( LAPACKE_lsame( storev, 'c' ) && LAPACKE_lsame( direct, 'f' ) ) {
75-
if( LAPACKE_ctr_nancheck( matrix_layout, 'l', 'u', k, v, ldv ) )
76-
return -9;
77-
if( LAPACKE_cge_nancheck( matrix_layout, nrows_v-k, ncols_v,
78-
&v[k*lrv], ldv ) )
79-
return -9;
80-
} else if( LAPACKE_lsame( storev, 'c' ) && LAPACKE_lsame( direct, 'b' ) ) {
81-
if( k > nrows_v ) {
82-
LAPACKE_xerbla( "LAPACKE_clarfb", -8 );
83-
return -8;
84-
}
85-
if( LAPACKE_ctr_nancheck( matrix_layout, 'u', 'u', k,
86-
&v[(nrows_v-k)*lrv], ldv ) )
87-
return -9;
88-
if( LAPACKE_cge_nancheck( matrix_layout, nrows_v-k, ncols_v, v, ldv ) )
89-
return -9;
90-
} else if( LAPACKE_lsame( storev, 'r' ) && LAPACKE_lsame( direct, 'f' ) ) {
91-
if( LAPACKE_ctr_nancheck( matrix_layout, 'u', 'u', k, v, ldv ) )
92-
return -9;
93-
if( LAPACKE_cge_nancheck( matrix_layout, nrows_v, ncols_v-k,
94-
&v[k*lrv], ldv ) )
95-
return -9;
96-
} else if( LAPACKE_lsame( storev, 'r' ) && LAPACKE_lsame( direct, 'b' ) ) {
97-
if( k > ncols_v ) {
98-
LAPACKE_xerbla( "LAPACKE_clarfb", -8 );
99-
return -8;
100-
}
101-
if( LAPACKE_ctr_nancheck( matrix_layout, 'l', 'u', k,
102-
&v[(ncols_v-k)*lcv], ldv ) )
103-
return -9;
104-
if( LAPACKE_cge_nancheck( matrix_layout, nrows_v, ncols_v-k, v, ldv ) )
105-
return -9;
74+
if( LAPACKE_cge_nancheck( matrix_layout, m, n, c, ldc ) ) {
75+
return -13;
10676
}
10777
}
10878
#endif

‎LAPACKE/src/lapacke_dlarfb.c

Lines changed: 18 additions & 48 deletions
Original file line numberDiff line numberDiff line change
@@ -42,66 +42,36 @@ lapack_int LAPACKE_dlarfb( int matrix_layout, char side, char trans, char direct
4242
lapack_int ldwork;
4343
double* work = NULL;
4444
lapack_int ncols_v, nrows_v;
45+
lapack_logical left, col, forward;
46+
char uplo;
4547
if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
4648
LAPACKE_xerbla( "LAPACKE_dlarfb", -1 );
4749
return -1;
4850
}
4951
#ifndef LAPACK_DISABLE_NAN_CHECK
5052
if( LAPACKE_get_nancheck() ) {
5153
/* Optionally check input matrices for NaNs */
52-
lapack_int lrv, lcv; /* row, column stride */
53-
if( matrix_layout == LAPACK_COL_MAJOR ) {
54-
lrv = 1;
55-
lcv = ldv;
56-
} else {
57-
lrv = ldv;
58-
lcv = 1;
59-
}
60-
ncols_v = LAPACKE_lsame( storev, 'c' ) ? k :
61-
( ( LAPACKE_lsame( storev, 'r' ) && LAPACKE_lsame( side, 'l' ) ) ? m :
62-
( ( LAPACKE_lsame( storev, 'r' ) && LAPACKE_lsame( side, 'r' ) ) ? n : 1) );
54+
left = LAPACKE_lsame( side, 'l' );
55+
col = LAPACKE_lsame( storev, 'c' );
56+
forward = LAPACKE_lsame( direct, 'f' );
6357

64-
nrows_v = ( LAPACKE_lsame( storev, 'c' ) && LAPACKE_lsame( side, 'l' ) ) ? m :
65-
( ( LAPACKE_lsame( storev, 'c' ) && LAPACKE_lsame( side, 'r' ) ) ? n :
66-
( LAPACKE_lsame( storev, 'r' ) ? k : 1) );
67-
if( LAPACKE_dge_nancheck( matrix_layout, m, n, c, ldc ) ) {
68-
return -13;
58+
ncols_v = ( !col && left ) ? m : ( ( !col && !left ) ? n : ( col ? k : 1 ) );
59+
nrows_v = ( col && left ) ? m : ( ( col && !left ) ? n : ( !col ? k : 1) );
60+
uplo = ( ( left && col ) || !( left || col ) ) ? 'l' : 'u';
61+
62+
if( !forward && ( col && k > nrows_v ) || ( !col && k > ncols_v )) {
63+
LAPACKE_xerbla( "LAPACKE_dlarfb", -8 );
64+
return -8;
65+
}
66+
if( LAPACKE_dtz_nancheck( matrix_layout, direct, uplo, 'u',
67+
ncols_v, nrows_v, v, ldv ) ) {
68+
return -9;
6969
}
7070
if( LAPACKE_dge_nancheck( matrix_layout, k, k, t, ldt ) ) {
7171
return -11;
7272
}
73-
if( LAPACKE_lsame( storev, 'c' ) && LAPACKE_lsame( direct, 'f' ) ) {
74-
if( LAPACKE_dtr_nancheck( matrix_layout, 'l', 'u', k, v, ldv ) )
75-
return -9;
76-
if( LAPACKE_dge_nancheck( matrix_layout, nrows_v-k, ncols_v,
77-
&v[k*lrv], ldv ) )
78-
return -9;
79-
} else if( LAPACKE_lsame( storev, 'c' ) && LAPACKE_lsame( direct, 'b' ) ) {
80-
if( k > nrows_v ) {
81-
LAPACKE_xerbla( "LAPACKE_dlarfb", -8 );
82-
return -8;
83-
}
84-
if( LAPACKE_dtr_nancheck( matrix_layout, 'u', 'u', k,
85-
&v[(nrows_v-k)*lrv], ldv ) )
86-
return -9;
87-
if( LAPACKE_dge_nancheck( matrix_layout, nrows_v-k, ncols_v, v, ldv ) )
88-
return -9;
89-
} else if( LAPACKE_lsame( storev, 'r' ) && LAPACKE_lsame( direct, 'f' ) ) {
90-
if( LAPACKE_dtr_nancheck( matrix_layout, 'u', 'u', k, v, ldv ) )
91-
return -9;
92-
if( LAPACKE_dge_nancheck( matrix_layout, nrows_v, ncols_v-k,
93-
&v[k*lrv], ldv ) )
94-
return -9;
95-
} else if( LAPACKE_lsame( storev, 'r' ) && LAPACKE_lsame( direct, 'b' ) ) {
96-
if( k > ncols_v ) {
97-
LAPACKE_xerbla( "LAPACKE_dlarfb", -8 );
98-
return -8;
99-
}
100-
if( LAPACKE_dtr_nancheck( matrix_layout, 'l', 'u', k,
101-
&v[(ncols_v-k)*lcv], ldv ) )
102-
return -9;
103-
if( LAPACKE_dge_nancheck( matrix_layout, nrows_v, ncols_v-k, v, ldv ) )
104-
return -9;
73+
if( LAPACKE_dge_nancheck( matrix_layout, m, n, c, ldc ) ) {
74+
return -13;
10575
}
10676
}
10777
#endif

‎LAPACKE/src/lapacke_slarfb.c

Lines changed: 18 additions & 48 deletions
Original file line numberDiff line numberDiff line change
@@ -42,66 +42,36 @@ lapack_int LAPACKE_slarfb( int matrix_layout, char side, char trans, char direct
4242
lapack_int ldwork;
4343
float* work = NULL;
4444
lapack_int ncols_v, nrows_v;
45+
lapack_logical left, col, forward;
46+
char uplo;
4547
if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
4648
LAPACKE_xerbla( "LAPACKE_slarfb", -1 );
4749
return -1;
4850
}
4951
#ifndef LAPACK_DISABLE_NAN_CHECK
5052
if( LAPACKE_get_nancheck() ) {
5153
/* Optionally check input matrices for NaNs */
52-
lapack_int lrv, lcv; /* row, column stride */
53-
if( matrix_layout == LAPACK_COL_MAJOR ) {
54-
lrv = 1;
55-
lcv = ldv;
56-
} else {
57-
lrv = ldv;
58-
lcv = 1;
59-
}
60-
ncols_v = LAPACKE_lsame( storev, 'c' ) ? k :
61-
( ( LAPACKE_lsame( storev, 'r' ) && LAPACKE_lsame( side, 'l' ) ) ? m :
62-
( ( LAPACKE_lsame( storev, 'r' ) && LAPACKE_lsame( side, 'r' ) ) ? n : 1) );
54+
left = LAPACKE_lsame( side, 'l' );
55+
col = LAPACKE_lsame( storev, 'c' );
56+
forward = LAPACKE_lsame( direct, 'f' );
6357

64-
nrows_v = ( LAPACKE_lsame( storev, 'c' ) && LAPACKE_lsame( side, 'l' ) ) ? m :
65-
( ( LAPACKE_lsame( storev, 'c' ) && LAPACKE_lsame( side, 'r' ) ) ? n :
66-
( LAPACKE_lsame( storev, 'r' ) ? k : 1) );
67-
if( LAPACKE_sge_nancheck( matrix_layout, m, n, c, ldc ) ) {
68-
return -13;
58+
ncols_v = ( !col && left ) ? m : ( ( !col && !left ) ? n : ( col ? k : 1 ) );
59+
nrows_v = ( col && left ) ? m : ( ( col && !left ) ? n : ( !col ? k : 1) );
60+
uplo = ( ( left && col ) || !( left || col ) ) ? 'l' : 'u';
61+
62+
if( !forward && ( col && k > nrows_v ) || ( !col && k > ncols_v )) {
63+
LAPACKE_xerbla( "LAPACKE_slarfb", -8 );
64+
return -8;
65+
}
66+
if( LAPACKE_stz_nancheck( matrix_layout, direct, uplo, 'u',
67+
ncols_v, nrows_v, v, ldv ) ) {
68+
return -9;
6969
}
7070
if( LAPACKE_sge_nancheck( matrix_layout, k, k, t, ldt ) ) {
7171
return -11;
7272
}
73-
if( LAPACKE_lsame( storev, 'c' ) && LAPACKE_lsame( direct, 'f' ) ) {
74-
if( LAPACKE_str_nancheck( matrix_layout, 'l', 'u', k, v, ldv ) )
75-
return -9;
76-
if( LAPACKE_sge_nancheck( matrix_layout, nrows_v-k, ncols_v,
77-
&v[k*lrv], ldv ) )
78-
return -9;
79-
} else if( LAPACKE_lsame( storev, 'c' ) && LAPACKE_lsame( direct, 'b' ) ) {
80-
if( k > nrows_v ) {
81-
LAPACKE_xerbla( "LAPACKE_slarfb", -8 );
82-
return -8;
83-
}
84-
if( LAPACKE_str_nancheck( matrix_layout, 'u', 'u', k,
85-
&v[(nrows_v-k)*lrv], ldv ) )
86-
return -9;
87-
if( LAPACKE_sge_nancheck( matrix_layout, nrows_v-k, ncols_v, v, ldv ) )
88-
return -9;
89-
} else if( LAPACKE_lsame( storev, 'r' ) && LAPACKE_lsame( direct, 'f' ) ) {
90-
if( LAPACKE_str_nancheck( matrix_layout, 'u', 'u', k, v, ldv ) )
91-
return -9;
92-
if( LAPACKE_sge_nancheck( matrix_layout, nrows_v, ncols_v-k,
93-
&v[k*lrv], ldv ) )
94-
return -9;
95-
} else if( LAPACKE_lsame( storev, 'r' ) && LAPACKE_lsame( direct, 'b' ) ) {
96-
if( k > ncols_v ) {
97-
LAPACKE_xerbla( "LAPACKE_slarfb", -8 );
98-
return -8;
99-
}
100-
if( LAPACKE_str_nancheck( matrix_layout, 'l', 'u', k,
101-
&v[(ncols_v-k)*lcv], ldv ) )
102-
return -9;
103-
if( LAPACKE_sge_nancheck( matrix_layout, nrows_v, ncols_v-k, v, ldv ) )
104-
return -9;
73+
if( LAPACKE_sge_nancheck( matrix_layout, m, n, c, ldc ) ) {
74+
return -13;
10575
}
10676
}
10777
#endif

‎LAPACKE/src/lapacke_zlarfb.c

Lines changed: 18 additions & 48 deletions
Original file line numberDiff line numberDiff line change
@@ -43,66 +43,36 @@ lapack_int LAPACKE_zlarfb( int matrix_layout, char side, char trans, char direct
4343
lapack_int ldwork;
4444
lapack_complex_double* work = NULL;
4545
lapack_int ncols_v, nrows_v;
46+
lapack_logical left, col, forward;
47+
char uplo;
4648
if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
4749
LAPACKE_xerbla( "LAPACKE_zlarfb", -1 );
4850
return -1;
4951
}
5052
#ifndef LAPACK_DISABLE_NAN_CHECK
5153
if( LAPACKE_get_nancheck() ) {
5254
/* Optionally check input matrices for NaNs */
53-
lapack_int lrv, lcv; /* row, column stride */
54-
if( matrix_layout == LAPACK_COL_MAJOR ) {
55-
lrv = 1;
56-
lcv = ldv;
57-
} else {
58-
lrv = ldv;
59-
lcv = 1;
60-
}
61-
ncols_v = LAPACKE_lsame( storev, 'c' ) ? k :
62-
( ( LAPACKE_lsame( storev, 'r' ) && LAPACKE_lsame( side, 'l' ) ) ? m :
63-
( ( LAPACKE_lsame( storev, 'r' ) && LAPACKE_lsame( side, 'r' ) ) ? n : 1) );
55+
left = LAPACKE_lsame( side, 'l' );
56+
col = LAPACKE_lsame( storev, 'c' );
57+
forward = LAPACKE_lsame( direct, 'f' );
6458

65-
nrows_v = ( LAPACKE_lsame( storev, 'c' ) && LAPACKE_lsame( side, 'l' ) ) ? m :
66-
( ( LAPACKE_lsame( storev, 'c' ) && LAPACKE_lsame( side, 'r' ) ) ? n :
67-
( LAPACKE_lsame( storev, 'r' ) ? k : 1) );
68-
if( LAPACKE_zge_nancheck( matrix_layout, m, n, c, ldc ) ) {
69-
return -13;
59+
ncols_v = ( !col && left ) ? m : ( ( !col && !left ) ? n : ( col ? k : 1 ) );
60+
nrows_v = ( col && left ) ? m : ( ( col && !left ) ? n : ( !col ? k : 1) );
61+
uplo = ( ( left && col ) || !( left || col ) ) ? 'l' : 'u';
62+
63+
if( !forward && ( col && k > nrows_v ) || ( !col && k > ncols_v )) {
64+
LAPACKE_xerbla( "LAPACKE_zlarfb", -8 );
65+
return -8;
66+
}
67+
if( LAPACKE_ztz_nancheck( matrix_layout, direct, uplo, 'u',
68+
ncols_v, nrows_v, v, ldv ) ) {
69+
return -9;
7070
}
7171
if( LAPACKE_zge_nancheck( matrix_layout, k, k, t, ldt ) ) {
7272
return -11;
7373
}
74-
if( LAPACKE_lsame( storev, 'c' ) && LAPACKE_lsame( direct, 'f' ) ) {
75-
if( LAPACKE_ztr_nancheck( matrix_layout, 'l', 'u', k, v, ldv ) )
76-
return -9;
77-
if( LAPACKE_zge_nancheck( matrix_layout, nrows_v-k, ncols_v,
78-
&v[k*lrv], ldv ) )
79-
return -9;
80-
} else if( LAPACKE_lsame( storev, 'c' ) && LAPACKE_lsame( direct, 'b' ) ) {
81-
if( k > nrows_v ) {
82-
LAPACKE_xerbla( "LAPACKE_zlarfb", -8 );
83-
return -8;
84-
}
85-
if( LAPACKE_ztr_nancheck( matrix_layout, 'u', 'u', k,
86-
&v[(nrows_v-k)*lrv], ldv ) )
87-
return -9;
88-
if( LAPACKE_zge_nancheck( matrix_layout, nrows_v-k, ncols_v, v, ldv ) )
89-
return -9;
90-
} else if( LAPACKE_lsame( storev, 'r' ) && LAPACKE_lsame( direct, 'f' ) ) {
91-
if( LAPACKE_ztr_nancheck( matrix_layout, 'u', 'u', k, v, ldv ) )
92-
return -9;
93-
if( LAPACKE_zge_nancheck( matrix_layout, nrows_v, ncols_v-k,
94-
&v[k*lrv], ldv ) )
95-
return -9;
96-
} else if( LAPACKE_lsame( storev, 'r' ) && LAPACKE_lsame( direct, 'b' ) ) {
97-
if( k > ncols_v ) {
98-
LAPACKE_xerbla( "LAPACKE_zlarfb", -8 );
99-
return -8;
100-
}
101-
if( LAPACKE_ztr_nancheck( matrix_layout, 'l', 'u', k,
102-
&v[(ncols_v-k)*lcv], ldv ) )
103-
return -9;
104-
if( LAPACKE_zge_nancheck( matrix_layout, nrows_v, ncols_v-k, v, ldv ) )
105-
return -9;
74+
if( LAPACKE_zge_nancheck( matrix_layout, m, n, c, ldc ) ) {
75+
return -13;
10676
}
10777
}
10878
#endif

0 commit comments

Comments
 (0)