OSchip
/
OpenBLAS
Not watched
1
0
Fork 0
Code
Releases 66 Wiki evaluate Activity
Issues 0 Pull Requests 0 Datasets Model Cloudbrain HPC
Browse Source

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

tags/v0.3.22^2
Martin Kroeker GitHub 3 years ago
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
Split View
Diff Options
Show Stats Download Patch File Download Diff File
  1. +3
    -3
      lapack-netlib/LAPACKE/src/lapacke_clantr.c
  2. +19
    -49
      lapack-netlib/LAPACKE/src/lapacke_clarfb.c
  3. +17
    -40
      lapack-netlib/LAPACKE/src/lapacke_clarfb_work.c
  4. +1
    -1
      lapack-netlib/LAPACKE/src/lapacke_dlantr.c
  5. +19
    -49
      lapack-netlib/LAPACKE/src/lapacke_dlarfb.c
  6. +17
    -40
      lapack-netlib/LAPACKE/src/lapacke_dlarfb_work.c
  7. +1
    -1
      lapack-netlib/LAPACKE/src/lapacke_slantr.c
  8. +19
    -49
      lapack-netlib/LAPACKE/src/lapacke_slarfb.c
  9. +17
    -40
      lapack-netlib/LAPACKE/src/lapacke_slarfb_work.c
  10. +1
    -1
      lapack-netlib/LAPACKE/src/lapacke_zlantr.c
  11. +19
    -49
      lapack-netlib/LAPACKE/src/lapacke_zlarfb.c
  12. +17
    -40
      lapack-netlib/LAPACKE/src/lapacke_zlarfb_work.c

+ 3
- 3
lapack-netlib/LAPACKE/src/lapacke_clantr.c View File

@@ -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;
}
}


+ 19
- 49
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 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


+ 17
- 40
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 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 */


+ 1
- 1
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
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;
}
}


+ 19
- 49
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 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


+ 17
- 40
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 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 */


+ 1
- 1
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
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;
}
}


+ 19
- 49
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 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


+ 17
- 40
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 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 */


+ 1
- 1
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
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;
}
}


+ 19
- 49
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 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


+ 17
- 40
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 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 */


Write Preview
Loading…
Cancel
Save