Skip to content

Commit

Permalink
Merge pull request Reference-LAPACK#1042 from sergey-v-kuznetsov/lapa…
Browse files Browse the repository at this point in the history 
…cke_tfsm_fixes
  • Loading branch information
@langou
langou authored Aug 10, 2024
2 parents 3c351aa + 7fd3d47 commit dd49b19
Show file tree
Hide file tree
Showing 12 changed files with 42 additions and 22 deletions.
4 changes: 3 additions & 1 deletion LAPACKE/src/lapacke_ctfsm.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -44,9 +44,11 @@ lapack_int API_SUFFIX(LAPACKE_ctfsm)( int matrix_layout, char transr, char side,
}
#ifndef LAPACK_DISABLE_NAN_CHECK
if( LAPACKE_get_nancheck() ) {
lapack_int mn = m;
if( LAPACKE_lsame( side, 'r' ) ) mn = n;
/* Optionally check input matrices for NaNs */
if( IS_C_NONZERO(alpha) ) {
if( API_SUFFIX(LAPACKE_ctf_nancheck)( matrix_layout, transr, uplo, diag, n, a ) ) {
if( API_SUFFIX(LAPACKE_ctf_nancheck)( matrix_layout, transr, uplo, diag, mn, a ) ) {
return -10;
}
}
Expand Down
8 changes: 5 additions & 3 deletions LAPACKE/src/lapacke_ctfsm_work.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -48,10 +48,12 @@ lapack_int API_SUFFIX(LAPACKE_ctfsm_work)( int matrix_layout, char transr, char
}
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
lapack_int ldb_t = MAX(1,m);
lapack_int mn = m;
lapack_complex_float* b_t = NULL;
lapack_complex_float* a_t = NULL;
if( LAPACKE_lsame( side, 'r' ) ) mn = n;
/* Check leading dimension(s) */
if( ldb < n ) {
if( ldb < m ) {
info = -12;
API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctfsm_work", info );
return info;
Expand All @@ -66,7 +68,7 @@ lapack_int API_SUFFIX(LAPACKE_ctfsm_work)( int matrix_layout, char transr, char
if( IS_C_NONZERO(alpha) ) {
a_t = (lapack_complex_float*)
LAPACKE_malloc( sizeof(lapack_complex_float) *
( MAX(1,n) * MAX(2,n+1) ) / 2 );
( MAX(1,mn) * MAX(2,mn+1) ) / 2 );
if( a_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_1;
Expand All @@ -77,7 +79,7 @@ lapack_int API_SUFFIX(LAPACKE_ctfsm_work)( int matrix_layout, char transr, char
API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, b, ldb, b_t, ldb_t );
}
if( IS_C_NONZERO(alpha) ) {
API_SUFFIX(LAPACKE_ctf_trans)( matrix_layout, transr, uplo, diag, n, a, a_t );
API_SUFFIX(LAPACKE_ctf_trans)( matrix_layout, transr, uplo, diag, mn, a, a_t );
}
/* Call LAPACK function and adjust info */
LAPACK_ctfsm( &transr, &side, &uplo, &trans, &diag, &m, &n, &alpha, a_t,
Expand Down
4 changes: 3 additions & 1 deletion LAPACKE/src/lapacke_dtfsm.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -44,8 +44,10 @@ lapack_int API_SUFFIX(LAPACKE_dtfsm)( int matrix_layout, char transr, char side,
#ifndef LAPACK_DISABLE_NAN_CHECK
if( LAPACKE_get_nancheck() ) {
/* Optionally check input matrices for NaNs */
lapack_int mn = m;
if( LAPACKE_lsame( side, 'r' ) ) mn = n;
if( IS_D_NONZERO(alpha) ) {
if( API_SUFFIX(LAPACKE_dtf_nancheck)( matrix_layout, transr, uplo, diag, n, a ) ) {
if( API_SUFFIX(LAPACKE_dtf_nancheck)( matrix_layout, transr, uplo, diag, mn, a ) ) {
return -10;
}
}
Expand Down
8 changes: 5 additions & 3 deletions LAPACKE/src/lapacke_dtfsm_work.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -47,10 +47,12 @@ lapack_int API_SUFFIX(LAPACKE_dtfsm_work)( int matrix_layout, char transr, char
}
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
lapack_int ldb_t = MAX(1,m);
lapack_int mn = m;
double* b_t = NULL;
double* a_t = NULL;
if( LAPACKE_lsame( side, 'r' ) ) mn = n;
/* Check leading dimension(s) */
if( ldb < n ) {
if( ldb < m ) {
info = -12;
API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtfsm_work", info );
return info;
Expand All @@ -64,7 +66,7 @@ lapack_int API_SUFFIX(LAPACKE_dtfsm_work)( int matrix_layout, char transr, char
if( IS_D_NONZERO(alpha) ) {
a_t = (double*)
LAPACKE_malloc( sizeof(double) *
( MAX(1,n) * MAX(2,n+1) ) / 2 );
( MAX(1,mn) * MAX(2,mn+1) ) / 2 );
if( a_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_1;
Expand All @@ -75,7 +77,7 @@ lapack_int API_SUFFIX(LAPACKE_dtfsm_work)( int matrix_layout, char transr, char
API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, b, ldb, b_t, ldb_t );
}
if( IS_D_NONZERO(alpha) ) {
API_SUFFIX(LAPACKE_dtf_trans)( matrix_layout, transr, uplo, diag, n, a, a_t );
API_SUFFIX(LAPACKE_dtf_trans)( matrix_layout, transr, uplo, diag, mn, a, a_t );
}
/* Call LAPACK function and adjust info */
LAPACK_dtfsm( &transr, &side, &uplo, &trans, &diag, &m, &n, &alpha, a_t,
Expand Down
4 changes: 3 additions & 1 deletion LAPACKE/src/lapacke_stfsm.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -43,9 +43,11 @@ lapack_int API_SUFFIX(LAPACKE_stfsm)( int matrix_layout, char transr, char side,
}
#ifndef LAPACK_DISABLE_NAN_CHECK
if( LAPACKE_get_nancheck() ) {
lapack_int mn = m;
if( LAPACKE_lsame( side, 'r' ) ) mn = n;
/* Optionally check input matrices for NaNs */
if( IS_S_NONZERO(alpha) ) {
if( API_SUFFIX(LAPACKE_stf_nancheck)( matrix_layout, transr, uplo, diag, n, a ) ) {
if( API_SUFFIX(LAPACKE_stf_nancheck)( matrix_layout, transr, uplo, diag, mn, a ) ) {
return -10;
}
}
Expand Down
8 changes: 5 additions & 3 deletions LAPACKE/src/lapacke_stfsm_work.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -47,10 +47,12 @@ lapack_int API_SUFFIX(LAPACKE_stfsm_work)( int matrix_layout, char transr, char
}
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
lapack_int ldb_t = MAX(1,m);
lapack_int mn = MAX(1,m);
float* b_t = NULL;
float* a_t = NULL;
if( LAPACKE_lsame( side, 'r' ) ) mn = n;
/* Check leading dimension(s) */
if( ldb < n ) {
if( ldb < m ) {
info = -12;
API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stfsm_work", info );
return info;
Expand All @@ -63,7 +65,7 @@ lapack_int API_SUFFIX(LAPACKE_stfsm_work)( int matrix_layout, char transr, char
}
if( IS_S_NONZERO(alpha) ) {
a_t = (float*)
LAPACKE_malloc( sizeof(float) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
LAPACKE_malloc( sizeof(float) * ( MAX(1,mn) * MAX(2,mn+1) ) / 2 );
if( a_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_1;
Expand All @@ -74,7 +76,7 @@ lapack_int API_SUFFIX(LAPACKE_stfsm_work)( int matrix_layout, char transr, char
API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, b, ldb, b_t, ldb_t );
}
if( IS_S_NONZERO(alpha) ) {
API_SUFFIX(LAPACKE_stf_trans)( matrix_layout, transr, uplo, diag, n, a, a_t );
API_SUFFIX(LAPACKE_stf_trans)( matrix_layout, transr, uplo, diag, mn, a, a_t );
}
/* Call LAPACK function and adjust info */
LAPACK_stfsm( &transr, &side, &uplo, &trans, &diag, &m, &n, &alpha, a_t,
Expand Down
4 changes: 3 additions & 1 deletion LAPACKE/src/lapacke_ztfsm.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -44,9 +44,11 @@ lapack_int API_SUFFIX(LAPACKE_ztfsm)( int matrix_layout, char transr, char side,
}
#ifndef LAPACK_DISABLE_NAN_CHECK
if( LAPACKE_get_nancheck() ) {
lapack_int mn = m;
if( LAPACKE_lsame( side, 'r' ) ) mn = n;
/* Optionally check input matrices for NaNs */
if( IS_Z_NONZERO(alpha) ) {
if( API_SUFFIX(LAPACKE_ztf_nancheck)( matrix_layout, transr, uplo, diag, n, a ) ) {
if( API_SUFFIX(LAPACKE_ztf_nancheck)( matrix_layout, transr, uplo, diag, mn, a ) ) {
return -10;
}
}
Expand Down
10 changes: 6 additions & 4 deletions LAPACKE/src/lapacke_ztfsm_work.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -48,10 +48,12 @@ lapack_int API_SUFFIX(LAPACKE_ztfsm_work)( int matrix_layout, char transr, char
}
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
lapack_int ldb_t = MAX(1,m);
lapack_int mn = m;
lapack_complex_double* b_t = NULL;
lapack_complex_double* a_t = NULL;
if( LAPACKE_lsame( side, 'r' ) ) mn = n;
/* Check leading dimension(s) */
if( ldb < n ) {
if( ldb < m ) {
info = -12;
API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztfsm_work", info );
return info;
Expand All @@ -66,7 +68,7 @@ lapack_int API_SUFFIX(LAPACKE_ztfsm_work)( int matrix_layout, char transr, char
if( IS_Z_NONZERO(alpha) ) {
a_t = (lapack_complex_double*)
LAPACKE_malloc( sizeof(lapack_complex_double) *
( MAX(1,n) * MAX(2,n+1) ) / 2 );
( MAX(1,mn) * MAX(2,mn+1) ) / 2 );
if( a_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_1;
Expand All @@ -77,14 +79,14 @@ lapack_int API_SUFFIX(LAPACKE_ztfsm_work)( int matrix_layout, char transr, char
API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, b, ldb, b_t, ldb_t );
}
if( IS_Z_NONZERO(alpha) ) {
API_SUFFIX(LAPACKE_ztf_trans)( matrix_layout, transr, uplo, diag, n, a, a_t );
API_SUFFIX(LAPACKE_ztf_trans)( matrix_layout, transr, uplo, diag, mn, a, a_t );
}
/* Call LAPACK function and adjust info */
LAPACK_ztfsm( &transr, &side, &uplo, &trans, &diag, &m, &n, &alpha, a_t,
b_t, &ldb_t );
info = 0; /* LAPACK call is ok! */
/* Transpose output matrices */
API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb );
LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb );
/* Release memory and exit */
if( IS_Z_NONZERO(alpha) ) {
LAPACKE_free( a_t );
Expand Down
5 changes: 3 additions & 2 deletions SRC/ctfsm.f
View file
Original file line number Diff line number Diff line change
Expand Up @@ -140,8 +140,9 @@
*>
*> \param[in] A
*> \verbatim
*> A is COMPLEX array, dimension (N*(N+1)/2)
*> NT = N*(N+1)/2. On entry, the matrix A in RFP Format.
*> A is COMPLEX array, dimension (NT)
*> NT = N*(N+1)/2 if SIDE='R' and NT = M*(M+1)/2 otherwise.
*> On entry, the matrix A in RFP Format.
*> RFP Format is described by TRANSR, UPLO and N as follows:
*> If TRANSR='N' then RFP A is (0:N,0:K-1) when N is even;
*> K=N/2. RFP A is (0:N-1,0:K) when N is odd; K=N/2. If
Expand Down
3 changes: 2 additions & 1 deletion SRC/dtfsm.f
View file
Original file line number Diff line number Diff line change
Expand Up @@ -141,7 +141,8 @@
*> \param[in] A
*> \verbatim
*> A is DOUBLE PRECISION array, dimension (NT)
*> NT = N*(N+1)/2. On entry, the matrix A in RFP Format.
*> NT = N*(N+1)/2 if SIDE='R' and NT = M*(M+1)/2 otherwise.
*> On entry, the matrix A in RFP Format.
*> RFP Format is described by TRANSR, UPLO and N as follows:
*> If TRANSR='N' then RFP A is (0:N,0:K-1) when N is even;
*> K=N/2. RFP A is (0:N-1,0:K) when N is odd; K=N/2. If
Expand Down
3 changes: 2 additions & 1 deletion SRC/stfsm.f
View file
Original file line number Diff line number Diff line change
Expand Up @@ -141,7 +141,8 @@
*> \param[in] A
*> \verbatim
*> A is REAL array, dimension (NT)
*> NT = N*(N+1)/2. On entry, the matrix A in RFP Format.
*> NT = N*(N+1)/2 if SIDE='R' and NT = M*(M+1)/2 otherwise.
*> On entry, the matrix A in RFP Format.
*> RFP Format is described by TRANSR, UPLO and N as follows:
*> If TRANSR='N' then RFP A is (0:N,0:K-1) when N is even;
*> K=N/2. RFP A is (0:N-1,0:K) when N is odd; K=N/2. If
Expand Down
3 changes: 2 additions & 1 deletion SRC/ztfsm.f
View file
Original file line number Diff line number Diff line change
Expand Up @@ -141,7 +141,8 @@
*> \param[in] A
*> \verbatim
*> A is COMPLEX*16 array, dimension (N*(N+1)/2)
*> NT = N*(N+1)/2. On entry, the matrix A in RFP Format.
*> NT = N*(N+1)/2 if SIDE='R' and NT = M*(M+1)/2 otherwise.
*> On entry, the matrix A in RFP Format.
*> RFP Format is described by TRANSR, UPLO and N as follows:
*> If TRANSR='N' then RFP A is (0:N,0:K-1) when N is even;
*> K=N/2. RFP A is (0:N-1,0:K) when N is odd; K=N/2. If
Expand Down

0 comments on commit dd49b19

Please sign in to comment.