Merge pull request #3817 from martin-frbg/lapack738742
Add NaN check functions for trapezoidal matrices to LAPACKE (Reference-LAPACK PR 738+742)
This commit is contained in:
commit
92411dfecb
|
@ -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 "")
|
||||
|
|
|
@ -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
|
||||
}
|
||||
|
|
|
@ -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;
|
||||
}
|
||||
}
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 */
|
||||
|
|
|
@ -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;
|
||||
}
|
||||
}
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 */
|
||||
|
|
|
@ -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;
|
||||
}
|
||||
}
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 */
|
||||
|
|
|
@ -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;
|
||||
}
|
||||
}
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 */
|
||||
|
|
|
@ -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
|
||||
)
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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 );
|
||||
}
|
|
@ -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 );
|
||||
}
|
|
@ -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 );
|
||||
}
|
|
@ -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 );
|
||||
}
|
|
@ -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 );
|
||||
}
|
|
@ -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 );
|
||||
}
|
|
@ -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 );
|
||||
}
|
|
@ -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 );
|
||||
}
|
Loading…
Reference in New Issue