floraachy
/
OpenBLAS
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Add NaN check functions for trapezoidal matrices (Reference-LAPACK PR738+742)

This commit is contained in:
Martin Kroeker 2022-11-13 14:55:45 +01:00 committed by GitHub
parent 6dcf737c5d
commit 23cfe58ee3
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
12 changed files with 150 additions and 362 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
lapack-netlib/LAPACKE/src/lapacke_clantr.c
View File

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

68
lapack-netlib/LAPACKE/src/lapacke_clarfb.c
View File

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

57
lapack-netlib/LAPACKE/src/lapacke_clarfb_work.c
View File

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

2
lapack-netlib/LAPACKE/src/lapacke_dlantr.c
View File

@ -46,7 +46,7 @@ double LAPACKE_dlantr( int matrix_layout, char norm, char uplo, char diag,
#ifndef LAPACK_DISABLE_NAN_CHECK #ifndef LAPACK_DISABLE_NAN_CHECK
if( LAPACKE_get_nancheck() ) { if( LAPACKE_get_nancheck() ) {
/* Optionally check input matrices for NaNs */ /* 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; return -7;
} }
} }

68
lapack-netlib/LAPACKE/src/lapacke_dlarfb.c
View File

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

57
lapack-netlib/LAPACKE/src/lapacke_dlarfb_work.c
View File

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

2
lapack-netlib/LAPACKE/src/lapacke_slantr.c
View File

@ -46,7 +46,7 @@ float LAPACKE_slantr( int matrix_layout, char norm, char uplo, char diag,
#ifndef LAPACK_DISABLE_NAN_CHECK #ifndef LAPACK_DISABLE_NAN_CHECK
if( LAPACKE_get_nancheck() ) { if( LAPACKE_get_nancheck() ) {
/* Optionally check input matrices for NaNs */ /* 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; return -7;
} }
} }

68
lapack-netlib/LAPACKE/src/lapacke_slarfb.c
View File

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

57
lapack-netlib/LAPACKE/src/lapacke_slarfb_work.c
View File

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

2
lapack-netlib/LAPACKE/src/lapacke_zlantr.c
View File

@ -46,7 +46,7 @@ double LAPACKE_zlantr( int matrix_layout, char norm, char uplo, char diag,
#ifndef LAPACK_DISABLE_NAN_CHECK #ifndef LAPACK_DISABLE_NAN_CHECK
if( LAPACKE_get_nancheck() ) { if( LAPACKE_get_nancheck() ) {
/* Optionally check input matrices for NaNs */ /* 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; return -7;
} }
} }

68
lapack-netlib/LAPACKE/src/lapacke_zlarfb.c
View File

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

57
lapack-netlib/LAPACKE/src/lapacke_zlarfb_work.c
View File

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