Skip to content

Commit c720f1f

Browse files
martin-frbgmartin-frbg
authored
Merge pull request #1554 from martin-frbg/lapack-249
LAPACKE fixes from lapack PR249
2 parents 12398e5 + d7d950f commit c720f1f

26 files changed

Lines changed: 122 additions & 94 deletions

‎lapack-netlib/LAPACKE/src/lapacke_clacgv.c‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -39,7 +39,7 @@ lapack_int LAPACKE_clacgv( lapack_int n, lapack_complex_float* x,
3939
#ifndef LAPACK_DISABLE_NAN_CHECK
4040
if( LAPACKE_get_nancheck() ) {
4141
/* Optionally check input matrices for NaNs */
42-
if( LAPACKE_c_nancheck( 1+(n-1)*ABS(incx), x, incx ) ) {
42+
if( LAPACKE_c_nancheck( n, x, incx ) ) {
4343
return -2;
4444
}
4545
}

‎lapack-netlib/LAPACKE/src/lapacke_clarfb.c‎

Lines changed: 23 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -51,16 +51,21 @@ lapack_int LAPACKE_clarfb( int matrix_layout, char side, char trans, char direct
5151
#ifndef LAPACK_DISABLE_NAN_CHECK
5252
if( LAPACKE_get_nancheck() ) {
5353
/* Optionally check input matrices for NaNs */
54-
ncols_v = LAPACKE_lsame( storev, 'c' ) ? k :
55-
( ( LAPACKE_lsame( storev, 'r' ) &&
56-
LAPACKE_lsame( side, 'l' ) ) ? m :
57-
( ( LAPACKE_lsame( storev, 'r' ) &&
58-
LAPACKE_lsame( side, 'r' ) ) ? n : 1) );
59-
nrows_v = ( LAPACKE_lsame( storev, 'c' ) &&
60-
LAPACKE_lsame( side, 'l' ) ) ? m :
61-
( ( LAPACKE_lsame( storev, 'c' ) &&
62-
LAPACKE_lsame( side, 'r' ) ) ? n :
63-
( LAPACKE_lsame( storev, 'r' ) ? k : 1) );
54+
lapack_int lrv, lcv; /* row, column stride */
55+
if( matrix_layout == LAPACK_COL_MAJOR ) {
56+
lrv = 1;
57+
lcv = ldv;
58+
} else {
59+
lrv = ldv;
60+
lcv = 1;
61+
}
62+
ncols_v = LAPACKE_lsame( storev, 'c' ) ? k :
63+
( ( LAPACKE_lsame( storev, 'r' ) && LAPACKE_lsame( side, 'l' ) ) ? m :
64+
( ( LAPACKE_lsame( storev, 'r' ) && LAPACKE_lsame( side, 'r' ) ) ? n : 1) );
65+
66+
nrows_v = ( LAPACKE_lsame( storev, 'c' ) && LAPACKE_lsame( side, 'l' ) ) ? m :
67+
( ( LAPACKE_lsame( storev, 'c' ) && LAPACKE_lsame( side, 'r' ) ) ? n :
68+
( LAPACKE_lsame( storev, 'r' ) ? k : 1) );
6469
if( LAPACKE_cge_nancheck( matrix_layout, m, n, c, ldc ) ) {
6570
return -13;
6671
}
@@ -70,32 +75,32 @@ lapack_int LAPACKE_clarfb( int matrix_layout, char side, char trans, char direct
7075
if( LAPACKE_lsame( storev, 'c' ) && LAPACKE_lsame( direct, 'f' ) ) {
7176
if( LAPACKE_ctr_nancheck( matrix_layout, 'l', 'u', k, v, ldv ) )
7277
return -9;
73-
if( LAPACKE_cge_nancheck( matrix_layout, nrows_v-k, ncols_v, &v[k*ldv],
74-
ldv ) )
78+
if( LAPACKE_cge_nancheck( matrix_layout, nrows_v-k, ncols_v,
79+
&v[k*lrv], ldv ) )
7580
return -9;
7681
} else if( LAPACKE_lsame( storev, 'c' ) && LAPACKE_lsame( direct, 'b' ) ) {
7782
if( k > nrows_v ) {
7883
LAPACKE_xerbla( "LAPACKE_clarfb", -8 );
7984
return -8;
8085
}
8186
if( LAPACKE_ctr_nancheck( matrix_layout, 'u', 'u', k,
82-
&v[(nrows_v-k)*ldv], ldv ) )
87+
&v[(nrows_v-k)*lrv], ldv ) )
8388
return -9;
8489
if( LAPACKE_cge_nancheck( matrix_layout, nrows_v-k, ncols_v, v, ldv ) )
8590
return -9;
8691
} else if( LAPACKE_lsame( storev, 'r' ) && LAPACKE_lsame( direct, 'f' ) ) {
8792
if( LAPACKE_ctr_nancheck( matrix_layout, 'u', 'u', k, v, ldv ) )
8893
return -9;
89-
if( LAPACKE_cge_nancheck( matrix_layout, nrows_v, ncols_v-k, &v[k],
90-
ldv ) )
94+
if( LAPACKE_cge_nancheck( matrix_layout, nrows_v, ncols_v-k,
95+
&v[k*lrv], ldv ) )
9196
return -9;
92-
} else if( LAPACKE_lsame( storev, 'r' ) && LAPACKE_lsame( direct, 'f' ) ) {
97+
} else if( LAPACKE_lsame( storev, 'r' ) && LAPACKE_lsame( direct, 'b' ) ) {
9398
if( k > ncols_v ) {
9499
LAPACKE_xerbla( "LAPACKE_clarfb", -8 );
95100
return -8;
96101
}
97-
if( LAPACKE_ctr_nancheck( matrix_layout, 'l', 'u', k, &v[ncols_v-k],
98-
ldv ) )
102+
if( LAPACKE_ctr_nancheck( matrix_layout, 'l', 'u', k,
103+
&v[(ncols_v-k)*lcv], ldv ) )
99104
return -9;
100105
if( LAPACKE_cge_nancheck( matrix_layout, nrows_v, ncols_v-k, v, ldv ) )
101106
return -9;

‎lapack-netlib/LAPACKE/src/lapacke_clarfg.c‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -43,7 +43,7 @@ lapack_int LAPACKE_clarfg( lapack_int n, lapack_complex_float* alpha,
4343
if( LAPACKE_c_nancheck( 1, alpha, 1 ) ) {
4444
return -2;
4545
}
46-
if( LAPACKE_c_nancheck( 1+(n-2)*ABS(incx), x, incx ) ) {
46+
if( LAPACKE_c_nancheck( n-1, x, incx ) ) {
4747
return -3;
4848
}
4949
}

‎lapack-netlib/LAPACKE/src/lapacke_clarfx.c‎

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -38,6 +38,7 @@ lapack_int LAPACKE_clarfx( int matrix_layout, char side, lapack_int m,
3838
lapack_complex_float tau, lapack_complex_float* c,
3939
lapack_int ldc, lapack_complex_float* work )
4040
{
41+
lapack_int lv;
4142
if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
4243
LAPACKE_xerbla( "LAPACKE_clarfx", -1 );
4344
return -1;
@@ -51,7 +52,8 @@ lapack_int LAPACKE_clarfx( int matrix_layout, char side, lapack_int m,
5152
if( LAPACKE_c_nancheck( 1, &tau, 1 ) ) {
5253
return -6;
5354
}
54-
if( LAPACKE_c_nancheck( m, v, 1 ) ) {
55+
lv = (LAPACKE_lsame( side, 'l' ) ? m : n);
56+
if( LAPACKE_c_nancheck( lv, v, 1 ) ) {
5557
return -5;
5658
}
5759
}

‎lapack-netlib/LAPACKE/src/lapacke_classq.c‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -39,7 +39,7 @@ lapack_int LAPACKE_classq( lapack_int n, lapack_complex_float* x,
3939
#ifndef LAPACK_DISABLE_NAN_CHECK
4040
if( LAPACKE_get_nancheck() ) {
4141
/* Optionally check input vector `x` and in/out scalars `scale` and `sumsq` for NaNs */
42-
if( LAPACKE_c_nancheck( 1+(n-2)*ABS(incx), x, incx ) ) {
42+
if( LAPACKE_c_nancheck( n, x, incx ) ) {
4343
return -2;
4444
}
4545
if( LAPACKE_s_nancheck( 1, scale, 1 ) ) {

‎lapack-netlib/LAPACKE/src/lapacke_cunmtr.c‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -58,7 +58,7 @@ lapack_int LAPACKE_cunmtr( int matrix_layout, char side, char uplo, char trans,
5858
if( LAPACKE_cge_nancheck( matrix_layout, m, n, c, ldc ) ) {
5959
return -10;
6060
}
61-
if( LAPACKE_c_nancheck( m-1, tau, 1 ) ) {
61+
if( LAPACKE_c_nancheck( r-1, tau, 1 ) ) {
6262
return -9;
6363
}
6464
}

‎lapack-netlib/LAPACKE/src/lapacke_cupmtr.c‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -58,7 +58,7 @@ lapack_int LAPACKE_cupmtr( int matrix_layout, char side, char uplo, char trans,
5858
if( LAPACKE_cge_nancheck( matrix_layout, m, n, c, ldc ) ) {
5959
return -9;
6060
}
61-
if( LAPACKE_c_nancheck( m-1, tau, 1 ) ) {
61+
if( LAPACKE_c_nancheck( r-1, tau, 1 ) ) {
6262
return -8;
6363
}
6464
}

‎lapack-netlib/LAPACKE/src/lapacke_dlarfb.c‎

Lines changed: 23 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -50,16 +50,21 @@ lapack_int LAPACKE_dlarfb( int matrix_layout, char side, char trans, char direct
5050
#ifndef LAPACK_DISABLE_NAN_CHECK
5151
if( LAPACKE_get_nancheck() ) {
5252
/* Optionally check input matrices for NaNs */
53-
ncols_v = LAPACKE_lsame( storev, 'c' ) ? k :
54-
( ( LAPACKE_lsame( storev, 'r' ) &&
55-
LAPACKE_lsame( side, 'l' ) ) ? m :
56-
( ( LAPACKE_lsame( storev, 'r' ) &&
57-
LAPACKE_lsame( side, 'r' ) ) ? n : 1) );
58-
nrows_v = ( LAPACKE_lsame( storev, 'c' ) &&
59-
LAPACKE_lsame( side, 'l' ) ) ? m :
60-
( ( LAPACKE_lsame( storev, 'c' ) &&
61-
LAPACKE_lsame( side, 'r' ) ) ? n :
62-
( LAPACKE_lsame( storev, 'r' ) ? k : 1) );
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) );
64+
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) );
6368
if( LAPACKE_dge_nancheck( matrix_layout, m, n, c, ldc ) ) {
6469
return -13;
6570
}
@@ -69,32 +74,32 @@ lapack_int LAPACKE_dlarfb( int matrix_layout, char side, char trans, char direct
6974
if( LAPACKE_lsame( storev, 'c' ) && LAPACKE_lsame( direct, 'f' ) ) {
7075
if( LAPACKE_dtr_nancheck( matrix_layout, 'l', 'u', k, v, ldv ) )
7176
return -9;
72-
if( LAPACKE_dge_nancheck( matrix_layout, nrows_v-k, ncols_v, &v[k*ldv],
73-
ldv ) )
77+
if( LAPACKE_dge_nancheck( matrix_layout, nrows_v-k, ncols_v,
78+
&v[k*lrv], ldv ) )
7479
return -9;
7580
} else if( LAPACKE_lsame( storev, 'c' ) && LAPACKE_lsame( direct, 'b' ) ) {
7681
if( k > nrows_v ) {
7782
LAPACKE_xerbla( "LAPACKE_dlarfb", -8 );
7883
return -8;
7984
}
8085
if( LAPACKE_dtr_nancheck( matrix_layout, 'u', 'u', k,
81-
&v[(nrows_v-k)*ldv], ldv ) )
86+
&v[(nrows_v-k)*lrv], ldv ) )
8287
return -9;
8388
if( LAPACKE_dge_nancheck( matrix_layout, nrows_v-k, ncols_v, v, ldv ) )
8489
return -9;
8590
} else if( LAPACKE_lsame( storev, 'r' ) && LAPACKE_lsame( direct, 'f' ) ) {
8691
if( LAPACKE_dtr_nancheck( matrix_layout, 'u', 'u', k, v, ldv ) )
8792
return -9;
88-
if( LAPACKE_dge_nancheck( matrix_layout, nrows_v, ncols_v-k, &v[k],
89-
ldv ) )
93+
if( LAPACKE_dge_nancheck( matrix_layout, nrows_v, ncols_v-k,
94+
&v[k*lrv], ldv ) )
9095
return -9;
91-
} else if( LAPACKE_lsame( storev, 'r' ) && LAPACKE_lsame( direct, 'f' ) ) {
96+
} else if( LAPACKE_lsame( storev, 'r' ) && LAPACKE_lsame( direct, 'b' ) ) {
9297
if( k > ncols_v ) {
9398
LAPACKE_xerbla( "LAPACKE_dlarfb", -8 );
9499
return -8;
95100
}
96-
if( LAPACKE_dtr_nancheck( matrix_layout, 'l', 'u', k, &v[ncols_v-k],
97-
ldv ) )
101+
if( LAPACKE_dtr_nancheck( matrix_layout, 'l', 'u', k,
102+
&v[(ncols_v-k)*lcv], ldv ) )
98103
return -9;
99104
if( LAPACKE_dge_nancheck( matrix_layout, nrows_v, ncols_v-k, v, ldv ) )
100105
return -9;

‎lapack-netlib/LAPACKE/src/lapacke_dlarfg.c‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -42,7 +42,7 @@ lapack_int LAPACKE_dlarfg( lapack_int n, double* alpha, double* x,
4242
if( LAPACKE_d_nancheck( 1, alpha, 1 ) ) {
4343
return -2;
4444
}
45-
if( LAPACKE_d_nancheck( 1+(n-2)*ABS(incx), x, incx ) ) {
45+
if( LAPACKE_d_nancheck( n-1, x, incx ) ) {
4646
return -3;
4747
}
4848
}

‎lapack-netlib/LAPACKE/src/lapacke_dlarfx.c‎

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -37,6 +37,7 @@ lapack_int LAPACKE_dlarfx( int matrix_layout, char side, lapack_int m,
3737
lapack_int n, const double* v, double tau, double* c,
3838
lapack_int ldc, double* work )
3939
{
40+
lapack_int lv;
4041
if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
4142
LAPACKE_xerbla( "LAPACKE_dlarfx", -1 );
4243
return -1;
@@ -50,7 +51,8 @@ lapack_int LAPACKE_dlarfx( int matrix_layout, char side, lapack_int m,
5051
if( LAPACKE_d_nancheck( 1, &tau, 1 ) ) {
5152
return -6;
5253
}
53-
if( LAPACKE_d_nancheck( m, v, 1 ) ) {
54+
lv = (LAPACKE_lsame( side, 'l' ) ? m : n);
55+
if( LAPACKE_d_nancheck( lv, v, 1 ) ) {
5456
return -5;
5557
}
5658
}

0 commit comments

Comments
 (0)