Skip to content

Commit 80d7922

Browse files
martin-frbgmartin-frbg
authored
Merge pull request #5893 from martin-frbg/lapack1318
Fix LAPACKE_?lacpy_work corrupting data in row-major mode (Reference-LAPACK PR 1318)
2 parents de54968 + 2b11a16 commit 80d7922

4 files changed

Lines changed: 24 additions & 116 deletions

File tree

‎lapack-netlib/LAPACKE/src/lapacke_clacpy_work.c‎

Lines changed: 6 additions & 30 deletions
Original file line numberDiff line numberDiff line change
@@ -42,10 +42,7 @@ lapack_int LAPACKE_clacpy_work( int matrix_layout, char uplo, lapack_int m,
4242
/* Call LAPACK function and adjust info */
4343
LAPACK_clacpy( &uplo, &m, &n, a, &lda, b, &ldb );
4444
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
45-
lapack_int lda_t = MAX(1,m);
46-
lapack_int ldb_t = MAX(1,m);
47-
lapack_complex_float* a_t = NULL;
48-
lapack_complex_float* b_t = NULL;
45+
char uplo_t = uplo;
4946
/* Check leading dimension(s) */
5047
if( lda < n ) {
5148
info = -6;
@@ -57,34 +54,13 @@ lapack_int LAPACKE_clacpy_work( int matrix_layout, char uplo, lapack_int m,
5754
LAPACKE_xerbla( "LAPACKE_clacpy_work", info );
5855
return info;
5956
}
60-
/* Allocate memory for temporary array(s) */
61-
a_t = (lapack_complex_float*)
62-
LAPACKE_malloc( sizeof(lapack_complex_float) * lda_t * MAX(1,n) );
63-
if( a_t == NULL ) {
64-
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
65-
goto exit_level_0;
57+
if( uplo == 'U' || uplo == 'u' ) {
58+
uplo_t = 'L';
59+
} else if( uplo == 'L' || uplo == 'l' ) {
60+
uplo_t = 'U';
6661
}
67-
b_t = (lapack_complex_float*)
68-
LAPACKE_malloc( sizeof(lapack_complex_float) * ldb_t * MAX(1,n) );
69-
if( b_t == NULL ) {
70-
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
71-
goto exit_level_1;
72-
}
73-
/* Transpose input matrices */
74-
LAPACKE_cge_trans( matrix_layout, m, n, a, lda, a_t, lda_t );
75-
/* Call LAPACK function and adjust info */
76-
LAPACK_clacpy( &uplo, &m, &n, a_t, &lda_t, b_t, &ldb_t );
62+
LAPACK_clacpy( &uplo_t, &n, &m, a, &lda, b, &ldb );
7763
info = 0; /* LAPACK call is ok! */
78-
/* Transpose output matrices */
79-
LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb );
80-
/* Release memory and exit */
81-
LAPACKE_free( b_t );
82-
exit_level_1:
83-
LAPACKE_free( a_t );
84-
exit_level_0:
85-
if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
86-
LAPACKE_xerbla( "LAPACKE_clacpy_work", info );
87-
}
8864
} else {
8965
info = -1;
9066
LAPACKE_xerbla( "LAPACKE_clacpy_work", info );

‎lapack-netlib/LAPACKE/src/lapacke_dlacpy_work.c‎

Lines changed: 6 additions & 28 deletions
Original file line numberDiff line numberDiff line change
@@ -41,10 +41,7 @@ lapack_int LAPACKE_dlacpy_work( int matrix_layout, char uplo, lapack_int m,
4141
/* Call LAPACK function and adjust info */
4242
LAPACK_dlacpy( &uplo, &m, &n, a, &lda, b, &ldb );
4343
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
44-
lapack_int lda_t = MAX(1,m);
45-
lapack_int ldb_t = MAX(1,m);
46-
double* a_t = NULL;
47-
double* b_t = NULL;
44+
char uplo_t = uplo;
4845
/* Check leading dimension(s) */
4946
if( lda < n ) {
5047
info = -6;
@@ -56,32 +53,13 @@ lapack_int LAPACKE_dlacpy_work( int matrix_layout, char uplo, lapack_int m,
5653
LAPACKE_xerbla( "LAPACKE_dlacpy_work", info );
5754
return info;
5855
}
59-
/* Allocate memory for temporary array(s) */
60-
a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
61-
if( a_t == NULL ) {
62-
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
63-
goto exit_level_0;
56+
if( uplo == 'U' || uplo == 'u' ) {
57+
uplo_t = 'L';
58+
} else if( uplo == 'L' || uplo == 'l' ) {
59+
uplo_t = 'U';
6460
}
65-
b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,n) );
66-
if( b_t == NULL ) {
67-
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
68-
goto exit_level_1;
69-
}
70-
/* Transpose input matrices */
71-
LAPACKE_dge_trans( matrix_layout, m, n, a, lda, a_t, lda_t );
72-
/* Call LAPACK function and adjust info */
73-
LAPACK_dlacpy( &uplo, &m, &n, a_t, &lda_t, b_t, &ldb_t );
61+
LAPACK_dlacpy( &uplo_t, &n, &m, a, &lda, b, &ldb );
7462
info = 0; /* LAPACK call is ok! */
75-
/* Transpose output matrices */
76-
LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb );
77-
/* Release memory and exit */
78-
LAPACKE_free( b_t );
79-
exit_level_1:
80-
LAPACKE_free( a_t );
81-
exit_level_0:
82-
if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
83-
LAPACKE_xerbla( "LAPACKE_dlacpy_work", info );
84-
}
8563
} else {
8664
info = -1;
8765
LAPACKE_xerbla( "LAPACKE_dlacpy_work", info );

‎lapack-netlib/LAPACKE/src/lapacke_slacpy_work.c‎

Lines changed: 6 additions & 28 deletions
Original file line numberDiff line numberDiff line change
@@ -41,10 +41,7 @@ lapack_int LAPACKE_slacpy_work( int matrix_layout, char uplo, lapack_int m,
4141
/* Call LAPACK function and adjust info */
4242
LAPACK_slacpy( &uplo, &m, &n, a, &lda, b, &ldb );
4343
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
44-
lapack_int lda_t = MAX(1,m);
45-
lapack_int ldb_t = MAX(1,m);
46-
float* a_t = NULL;
47-
float* b_t = NULL;
44+
char uplo_t = uplo;
4845
/* Check leading dimension(s) */
4946
if( lda < n ) {
5047
info = -6;
@@ -56,32 +53,13 @@ lapack_int LAPACKE_slacpy_work( int matrix_layout, char uplo, lapack_int m,
5653
LAPACKE_xerbla( "LAPACKE_slacpy_work", info );
5754
return info;
5855
}
59-
/* Allocate memory for temporary array(s) */
60-
a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
61-
if( a_t == NULL ) {
62-
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
63-
goto exit_level_0;
56+
if( uplo == 'U' || uplo == 'u' ) {
57+
uplo_t = 'L';
58+
} else if( uplo == 'L' || uplo == 'l' ) {
59+
uplo_t = 'U';
6460
}
65-
b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,n) );
66-
if( b_t == NULL ) {
67-
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
68-
goto exit_level_1;
69-
}
70-
/* Transpose input matrices */
71-
LAPACKE_sge_trans( matrix_layout, m, n, a, lda, a_t, lda_t );
72-
/* Call LAPACK function and adjust info */
73-
LAPACK_slacpy( &uplo, &m, &n, a_t, &lda_t, b_t, &ldb_t );
61+
LAPACK_slacpy( &uplo_t, &n, &m, a, &lda, b, &ldb );
7462
info = 0; /* LAPACK call is ok! */
75-
/* Transpose output matrices */
76-
LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb );
77-
/* Release memory and exit */
78-
LAPACKE_free( b_t );
79-
exit_level_1:
80-
LAPACKE_free( a_t );
81-
exit_level_0:
82-
if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
83-
LAPACKE_xerbla( "LAPACKE_slacpy_work", info );
84-
}
8563
} else {
8664
info = -1;
8765
LAPACKE_xerbla( "LAPACKE_slacpy_work", info );

‎lapack-netlib/LAPACKE/src/lapacke_zlacpy_work.c‎

Lines changed: 6 additions & 30 deletions
Original file line numberDiff line numberDiff line change
@@ -42,10 +42,7 @@ lapack_int LAPACKE_zlacpy_work( int matrix_layout, char uplo, lapack_int m,
4242
/* Call LAPACK function and adjust info */
4343
LAPACK_zlacpy( &uplo, &m, &n, a, &lda, b, &ldb );
4444
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
45-
lapack_int lda_t = MAX(1,m);
46-
lapack_int ldb_t = MAX(1,m);
47-
lapack_complex_double* a_t = NULL;
48-
lapack_complex_double* b_t = NULL;
45+
char uplo_t = uplo;
4946
/* Check leading dimension(s) */
5047
if( lda < n ) {
5148
info = -6;
@@ -57,34 +54,13 @@ lapack_int LAPACKE_zlacpy_work( int matrix_layout, char uplo, lapack_int m,
5754
LAPACKE_xerbla( "LAPACKE_zlacpy_work", info );
5855
return info;
5956
}
60-
/* Allocate memory for temporary array(s) */
61-
a_t = (lapack_complex_double*)
62-
LAPACKE_malloc( sizeof(lapack_complex_double) * lda_t * MAX(1,n) );
63-
if( a_t == NULL ) {
64-
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
65-
goto exit_level_0;
57+
if( uplo == 'U' || uplo == 'u' ) {
58+
uplo_t = 'L';
59+
} else if( uplo == 'L' || uplo == 'l' ) {
60+
uplo_t = 'U';
6661
}
67-
b_t = (lapack_complex_double*)
68-
LAPACKE_malloc( sizeof(lapack_complex_double) * ldb_t * MAX(1,n) );
69-
if( b_t == NULL ) {
70-
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
71-
goto exit_level_1;
72-
}
73-
/* Transpose input matrices */
74-
LAPACKE_zge_trans( matrix_layout, m, n, a, lda, a_t, lda_t );
75-
/* Call LAPACK function and adjust info */
76-
LAPACK_zlacpy( &uplo, &m, &n, a_t, &lda_t, b_t, &ldb_t );
62+
LAPACK_zlacpy( &uplo_t, &n, &m, a, &lda, b, &ldb );
7763
info = 0; /* LAPACK call is ok! */
78-
/* Transpose output matrices */
79-
LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb );
80-
/* Release memory and exit */
81-
LAPACKE_free( b_t );
82-
exit_level_1:
83-
LAPACKE_free( a_t );
84-
exit_level_0:
85-
if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
86-
LAPACKE_xerbla( "LAPACKE_zlacpy_work", info );
87-
}
8864
} else {
8965
info = -1;
9066
LAPACKE_xerbla( "LAPACKE_zlacpy_work", info );

0 commit comments

Comments
 (0)