Skip to content

Commit dd49b19

Browse files
langoulangou
authored
Merge pull request #1042 from sergey-v-kuznetsov/lapacke_tfsm_fixes
2 parents 3c351aa + 7fd3d47 commit dd49b19

12 files changed

+42
-22
lines changed

‎LAPACKE/src/lapacke_ctfsm.c

+3-1
Original file line numberDiff line numberDiff line change
@@ -44,9 +44,11 @@ lapack_int API_SUFFIX(LAPACKE_ctfsm)( int matrix_layout, char transr, char side,
4444
}
4545
#ifndef LAPACK_DISABLE_NAN_CHECK
4646
if( LAPACKE_get_nancheck() ) {
47+
lapack_int mn = m;
48+
if( LAPACKE_lsame( side, 'r' ) ) mn = n;
4749
/* Optionally check input matrices for NaNs */
4850
if( IS_C_NONZERO(alpha) ) {
49-
if( API_SUFFIX(LAPACKE_ctf_nancheck)( matrix_layout, transr, uplo, diag, n, a ) ) {
51+
if( API_SUFFIX(LAPACKE_ctf_nancheck)( matrix_layout, transr, uplo, diag, mn, a ) ) {
5052
return -10;
5153
}
5254
}

‎LAPACKE/src/lapacke_ctfsm_work.c

+5-3
Original file line numberDiff line numberDiff line change
@@ -48,10 +48,12 @@ lapack_int API_SUFFIX(LAPACKE_ctfsm_work)( int matrix_layout, char transr, char
4848
}
4949
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
5050
lapack_int ldb_t = MAX(1,m);
51+
lapack_int mn = m;
5152
lapack_complex_float* b_t = NULL;
5253
lapack_complex_float* a_t = NULL;
54+
if( LAPACKE_lsame( side, 'r' ) ) mn = n;
5355
/* Check leading dimension(s) */
54-
if( ldb < n ) {
56+
if( ldb < m ) {
5557
info = -12;
5658
API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ctfsm_work", info );
5759
return info;
@@ -66,7 +68,7 @@ lapack_int API_SUFFIX(LAPACKE_ctfsm_work)( int matrix_layout, char transr, char
6668
if( IS_C_NONZERO(alpha) ) {
6769
a_t = (lapack_complex_float*)
6870
LAPACKE_malloc( sizeof(lapack_complex_float) *
69-
( MAX(1,n) * MAX(2,n+1) ) / 2 );
71+
( MAX(1,mn) * MAX(2,mn+1) ) / 2 );
7072
if( a_t == NULL ) {
7173
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
7274
goto exit_level_1;
@@ -77,7 +79,7 @@ lapack_int API_SUFFIX(LAPACKE_ctfsm_work)( int matrix_layout, char transr, char
7779
API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, b, ldb, b_t, ldb_t );
7880
}
7981
if( IS_C_NONZERO(alpha) ) {
80-
API_SUFFIX(LAPACKE_ctf_trans)( matrix_layout, transr, uplo, diag, n, a, a_t );
82+
API_SUFFIX(LAPACKE_ctf_trans)( matrix_layout, transr, uplo, diag, mn, a, a_t );
8183
}
8284
/* Call LAPACK function and adjust info */
8385
LAPACK_ctfsm( &transr, &side, &uplo, &trans, &diag, &m, &n, &alpha, a_t,

‎LAPACKE/src/lapacke_dtfsm.c

+3-1
Original file line numberDiff line numberDiff line change
@@ -44,8 +44,10 @@ lapack_int API_SUFFIX(LAPACKE_dtfsm)( int matrix_layout, char transr, char side,
4444
#ifndef LAPACK_DISABLE_NAN_CHECK
4545
if( LAPACKE_get_nancheck() ) {
4646
/* Optionally check input matrices for NaNs */
47+
lapack_int mn = m;
48+
if( LAPACKE_lsame( side, 'r' ) ) mn = n;
4749
if( IS_D_NONZERO(alpha) ) {
48-
if( API_SUFFIX(LAPACKE_dtf_nancheck)( matrix_layout, transr, uplo, diag, n, a ) ) {
50+
if( API_SUFFIX(LAPACKE_dtf_nancheck)( matrix_layout, transr, uplo, diag, mn, a ) ) {
4951
return -10;
5052
}
5153
}

‎LAPACKE/src/lapacke_dtfsm_work.c

+5-3
Original file line numberDiff line numberDiff line change
@@ -47,10 +47,12 @@ lapack_int API_SUFFIX(LAPACKE_dtfsm_work)( int matrix_layout, char transr, char
4747
}
4848
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
4949
lapack_int ldb_t = MAX(1,m);
50+
lapack_int mn = m;
5051
double* b_t = NULL;
5152
double* a_t = NULL;
53+
if( LAPACKE_lsame( side, 'r' ) ) mn = n;
5254
/* Check leading dimension(s) */
53-
if( ldb < n ) {
55+
if( ldb < m ) {
5456
info = -12;
5557
API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dtfsm_work", info );
5658
return info;
@@ -64,7 +66,7 @@ lapack_int API_SUFFIX(LAPACKE_dtfsm_work)( int matrix_layout, char transr, char
6466
if( IS_D_NONZERO(alpha) ) {
6567
a_t = (double*)
6668
LAPACKE_malloc( sizeof(double) *
67-
( MAX(1,n) * MAX(2,n+1) ) / 2 );
69+
( MAX(1,mn) * MAX(2,mn+1) ) / 2 );
6870
if( a_t == NULL ) {
6971
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
7072
goto exit_level_1;
@@ -75,7 +77,7 @@ lapack_int API_SUFFIX(LAPACKE_dtfsm_work)( int matrix_layout, char transr, char
7577
API_SUFFIX(LAPACKE_dge_trans)( matrix_layout, m, n, b, ldb, b_t, ldb_t );
7678
}
7779
if( IS_D_NONZERO(alpha) ) {
78-
API_SUFFIX(LAPACKE_dtf_trans)( matrix_layout, transr, uplo, diag, n, a, a_t );
80+
API_SUFFIX(LAPACKE_dtf_trans)( matrix_layout, transr, uplo, diag, mn, a, a_t );
7981
}
8082
/* Call LAPACK function and adjust info */
8183
LAPACK_dtfsm( &transr, &side, &uplo, &trans, &diag, &m, &n, &alpha, a_t,

‎LAPACKE/src/lapacke_stfsm.c

+3-1
Original file line numberDiff line numberDiff line change
@@ -43,9 +43,11 @@ lapack_int API_SUFFIX(LAPACKE_stfsm)( int matrix_layout, char transr, char side,
4343
}
4444
#ifndef LAPACK_DISABLE_NAN_CHECK
4545
if( LAPACKE_get_nancheck() ) {
46+
lapack_int mn = m;
47+
if( LAPACKE_lsame( side, 'r' ) ) mn = n;
4648
/* Optionally check input matrices for NaNs */
4749
if( IS_S_NONZERO(alpha) ) {
48-
if( API_SUFFIX(LAPACKE_stf_nancheck)( matrix_layout, transr, uplo, diag, n, a ) ) {
50+
if( API_SUFFIX(LAPACKE_stf_nancheck)( matrix_layout, transr, uplo, diag, mn, a ) ) {
4951
return -10;
5052
}
5153
}

‎LAPACKE/src/lapacke_stfsm_work.c

+5-3
Original file line numberDiff line numberDiff line change
@@ -47,10 +47,12 @@ lapack_int API_SUFFIX(LAPACKE_stfsm_work)( int matrix_layout, char transr, char
4747
}
4848
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
4949
lapack_int ldb_t = MAX(1,m);
50+
lapack_int mn = MAX(1,m);
5051
float* b_t = NULL;
5152
float* a_t = NULL;
53+
if( LAPACKE_lsame( side, 'r' ) ) mn = n;
5254
/* Check leading dimension(s) */
53-
if( ldb < n ) {
55+
if( ldb < m ) {
5456
info = -12;
5557
API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_stfsm_work", info );
5658
return info;
@@ -63,7 +65,7 @@ lapack_int API_SUFFIX(LAPACKE_stfsm_work)( int matrix_layout, char transr, char
6365
}
6466
if( IS_S_NONZERO(alpha) ) {
6567
a_t = (float*)
66-
LAPACKE_malloc( sizeof(float) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
68+
LAPACKE_malloc( sizeof(float) * ( MAX(1,mn) * MAX(2,mn+1) ) / 2 );
6769
if( a_t == NULL ) {
6870
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
6971
goto exit_level_1;
@@ -74,7 +76,7 @@ lapack_int API_SUFFIX(LAPACKE_stfsm_work)( int matrix_layout, char transr, char
7476
API_SUFFIX(LAPACKE_sge_trans)( matrix_layout, m, n, b, ldb, b_t, ldb_t );
7577
}
7678
if( IS_S_NONZERO(alpha) ) {
77-
API_SUFFIX(LAPACKE_stf_trans)( matrix_layout, transr, uplo, diag, n, a, a_t );
79+
API_SUFFIX(LAPACKE_stf_trans)( matrix_layout, transr, uplo, diag, mn, a, a_t );
7880
}
7981
/* Call LAPACK function and adjust info */
8082
LAPACK_stfsm( &transr, &side, &uplo, &trans, &diag, &m, &n, &alpha, a_t,

‎LAPACKE/src/lapacke_ztfsm.c

+3-1
Original file line numberDiff line numberDiff line change
@@ -44,9 +44,11 @@ lapack_int API_SUFFIX(LAPACKE_ztfsm)( int matrix_layout, char transr, char side,
4444
}
4545
#ifndef LAPACK_DISABLE_NAN_CHECK
4646
if( LAPACKE_get_nancheck() ) {
47+
lapack_int mn = m;
48+
if( LAPACKE_lsame( side, 'r' ) ) mn = n;
4749
/* Optionally check input matrices for NaNs */
4850
if( IS_Z_NONZERO(alpha) ) {
49-
if( API_SUFFIX(LAPACKE_ztf_nancheck)( matrix_layout, transr, uplo, diag, n, a ) ) {
51+
if( API_SUFFIX(LAPACKE_ztf_nancheck)( matrix_layout, transr, uplo, diag, mn, a ) ) {
5052
return -10;
5153
}
5254
}

‎LAPACKE/src/lapacke_ztfsm_work.c

+6-4
Original file line numberDiff line numberDiff line change
@@ -48,10 +48,12 @@ lapack_int API_SUFFIX(LAPACKE_ztfsm_work)( int matrix_layout, char transr, char
4848
}
4949
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
5050
lapack_int ldb_t = MAX(1,m);
51+
lapack_int mn = m;
5152
lapack_complex_double* b_t = NULL;
5253
lapack_complex_double* a_t = NULL;
54+
if( LAPACKE_lsame( side, 'r' ) ) mn = n;
5355
/* Check leading dimension(s) */
54-
if( ldb < n ) {
56+
if( ldb < m ) {
5557
info = -12;
5658
API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_ztfsm_work", info );
5759
return info;
@@ -66,7 +68,7 @@ lapack_int API_SUFFIX(LAPACKE_ztfsm_work)( int matrix_layout, char transr, char
6668
if( IS_Z_NONZERO(alpha) ) {
6769
a_t = (lapack_complex_double*)
6870
LAPACKE_malloc( sizeof(lapack_complex_double) *
69-
( MAX(1,n) * MAX(2,n+1) ) / 2 );
71+
( MAX(1,mn) * MAX(2,mn+1) ) / 2 );
7072
if( a_t == NULL ) {
7173
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
7274
goto exit_level_1;
@@ -77,14 +79,14 @@ lapack_int API_SUFFIX(LAPACKE_ztfsm_work)( int matrix_layout, char transr, char
7779
API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, b, ldb, b_t, ldb_t );
7880
}
7981
if( IS_Z_NONZERO(alpha) ) {
80-
API_SUFFIX(LAPACKE_ztf_trans)( matrix_layout, transr, uplo, diag, n, a, a_t );
82+
API_SUFFIX(LAPACKE_ztf_trans)( matrix_layout, transr, uplo, diag, mn, a, a_t );
8183
}
8284
/* Call LAPACK function and adjust info */
8385
LAPACK_ztfsm( &transr, &side, &uplo, &trans, &diag, &m, &n, &alpha, a_t,
8486
b_t, &ldb_t );
8587
info = 0; /* LAPACK call is ok! */
8688
/* Transpose output matrices */
87-
API_SUFFIX(LAPACKE_zge_trans)( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb );
89+
LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb );
8890
/* Release memory and exit */
8991
if( IS_Z_NONZERO(alpha) ) {
9092
LAPACKE_free( a_t );

‎SRC/ctfsm.f

+3-2
Original file line numberDiff line numberDiff line change
@@ -140,8 +140,9 @@
140140
*>
141141
*> \param[in] A
142142
*> \verbatim
143-
*> A is COMPLEX array, dimension (N*(N+1)/2)
144-
*> NT = N*(N+1)/2. On entry, the matrix A in RFP Format.
143+
*> A is COMPLEX array, dimension (NT)
144+
*> NT = N*(N+1)/2 if SIDE='R' and NT = M*(M+1)/2 otherwise.
145+
*> On entry, the matrix A in RFP Format.
145146
*> RFP Format is described by TRANSR, UPLO and N as follows:
146147
*> If TRANSR='N' then RFP A is (0:N,0:K-1) when N is even;
147148
*> K=N/2. RFP A is (0:N-1,0:K) when N is odd; K=N/2. If

‎SRC/dtfsm.f

+2-1
Original file line numberDiff line numberDiff line change
@@ -141,7 +141,8 @@
141141
*> \param[in] A
142142
*> \verbatim
143143
*> A is DOUBLE PRECISION array, dimension (NT)
144-
*> NT = N*(N+1)/2. On entry, the matrix A in RFP Format.
144+
*> NT = N*(N+1)/2 if SIDE='R' and NT = M*(M+1)/2 otherwise.
145+
*> On entry, the matrix A in RFP Format.
145146
*> RFP Format is described by TRANSR, UPLO and N as follows:
146147
*> If TRANSR='N' then RFP A is (0:N,0:K-1) when N is even;
147148
*> K=N/2. RFP A is (0:N-1,0:K) when N is odd; K=N/2. If

‎SRC/stfsm.f

+2-1
Original file line numberDiff line numberDiff line change
@@ -141,7 +141,8 @@
141141
*> \param[in] A
142142
*> \verbatim
143143
*> A is REAL array, dimension (NT)
144-
*> NT = N*(N+1)/2. On entry, the matrix A in RFP Format.
144+
*> NT = N*(N+1)/2 if SIDE='R' and NT = M*(M+1)/2 otherwise.
145+
*> On entry, the matrix A in RFP Format.
145146
*> RFP Format is described by TRANSR, UPLO and N as follows:
146147
*> If TRANSR='N' then RFP A is (0:N,0:K-1) when N is even;
147148
*> K=N/2. RFP A is (0:N-1,0:K) when N is odd; K=N/2. If

‎SRC/ztfsm.f

+2-1
Original file line numberDiff line numberDiff line change
@@ -141,7 +141,8 @@
141141
*> \param[in] A
142142
*> \verbatim
143143
*> A is COMPLEX*16 array, dimension (N*(N+1)/2)
144-
*> NT = N*(N+1)/2. On entry, the matrix A in RFP Format.
144+
*> NT = N*(N+1)/2 if SIDE='R' and NT = M*(M+1)/2 otherwise.
145+
*> On entry, the matrix A in RFP Format.
145146
*> RFP Format is described by TRANSR, UPLO and N as follows:
146147
*> If TRANSR='N' then RFP A is (0:N,0:K-1) when N is even;
147148
*> K=N/2. RFP A is (0:N-1,0:K) when N is odd; K=N/2. If

0 commit comments

Comments
 (0)