Skip to content

Commit b8232c9

Browse files
martin-frbgmartin-frbg
authored
Merge pull request #3213 from martin-frbg/lapack382
Avoid allocating the transposed triangular matrix in LAPACKE_xlantr_work (Reference-LAPACK 382)
2 parents 114bbbc + 4bf00da commit b8232c9

4 files changed

Lines changed: 80 additions & 74 deletions

File tree

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

Lines changed: 20 additions & 19 deletions
Original file line numberDiff line numberDiff line change
@@ -41,45 +41,46 @@ float LAPACKE_clantr_work( int matrix_layout, char norm, char uplo,
4141
lapack_int info = 0;
4242
float res = 0.;
4343
if( matrix_layout == LAPACK_COL_MAJOR ) {
44-
/* Call LAPACK function and adjust info */
44+
/* Call LAPACK function */
4545
res = LAPACK_clantr( &norm, &uplo, &diag, &m, &n, a, &lda, work );
4646
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
47-
lapack_int lda_t = MAX(1,m);
48-
lapack_complex_float* a_t = NULL;
4947
float* work_lapack = NULL;
48+
char norm_lapack;
49+
char uplo_lapack;
5050
/* Check leading dimension(s) */
5151
if( lda < n ) {
5252
info = -8;
5353
LAPACKE_xerbla( "LAPACKE_clantr_work", info );
5454
return info;
5555
}
56-
/* Allocate memory for temporary array(s) */
57-
a_t = (lapack_complex_float*)
58-
LAPACKE_malloc( sizeof(lapack_complex_float) * lda_t * MAX(1,MAX(m,n)) );
59-
if( a_t == NULL ) {
60-
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
61-
goto exit_level_0;
56+
if( LAPACKE_lsame( norm, '1' ) || LAPACKE_lsame( norm, 'o' ) ) {
57+
norm_lapack = 'i';
58+
} else if( LAPACKE_lsame( norm, 'i' ) ) {
59+
norm_lapack = '1';
60+
} else {
61+
norm_lapack = norm;
62+
}
63+
if( LAPACKE_lsame( uplo, 'u' ) ) {
64+
uplo_lapack = 'l';
65+
} else {
66+
uplo_lapack = 'u';
6267
}
6368
/* Allocate memory for work array(s) */
64-
if( LAPACKE_lsame( norm, 'i' ) ) {
65-
work_lapack = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,m) );
69+
if( LAPACKE_lsame( norm_lapack, 'i' ) ) {
70+
work_lapack = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,n) );
6671
if( work_lapack == NULL ) {
6772
info = LAPACK_WORK_MEMORY_ERROR;
68-
goto exit_level_1;
73+
goto exit_level_0;
6974
}
7075
}
71-
/* Transpose input matrices */
72-
LAPACKE_ctr_trans( matrix_layout, uplo, diag, MAX(m,n), a, lda, a_t, lda_t );
73-
/* Call LAPACK function and adjust info */
74-
res = LAPACK_clantr( &norm, &uplo, &diag, &m, &n, a_t, &lda_t, work_lapack );
76+
/* Call LAPACK function */
77+
res = LAPACK_clantr( &norm_lapack, &uplo_lapack, &diag, &n, &m, a, &lda, work_lapack );
7578
/* Release memory and exit */
7679
if( work_lapack ) {
7780
LAPACKE_free( work_lapack );
7881
}
79-
exit_level_1:
80-
LAPACKE_free( a_t );
8182
exit_level_0:
82-
if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
83+
if( info == LAPACK_WORK_MEMORY_ERROR ) {
8384
LAPACKE_xerbla( "LAPACKE_clantr_work", info );
8485
}
8586
} else {

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

Lines changed: 20 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -40,44 +40,46 @@ double LAPACKE_dlantr_work( int matrix_layout, char norm, char uplo,
4040
lapack_int info = 0;
4141
double res = 0.;
4242
if( matrix_layout == LAPACK_COL_MAJOR ) {
43-
/* Call LAPACK function and adjust info */
43+
/* Call LAPACK function */
4444
res = LAPACK_dlantr( &norm, &uplo, &diag, &m, &n, a, &lda, work );
4545
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
46-
lapack_int lda_t = MAX(1,m);
47-
double* a_t = NULL;
4846
double* work_lapack = NULL;
47+
char norm_lapack;
48+
char uplo_lapack;
4949
/* Check leading dimension(s) */
5050
if( lda < n ) {
5151
info = -8;
5252
LAPACKE_xerbla( "LAPACKE_dlantr_work", info );
5353
return info;
5454
}
55-
/* Allocate memory for temporary array(s) */
56-
a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,MAX(m,n)) );
57-
if( a_t == NULL ) {
58-
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
59-
goto exit_level_0;
55+
if( LAPACKE_lsame( norm, '1' ) || LAPACKE_lsame( norm, 'o' ) ) {
56+
norm_lapack = 'i';
57+
} else if( LAPACKE_lsame( norm, 'i' ) ) {
58+
norm_lapack = '1';
59+
} else {
60+
norm_lapack = norm;
61+
}
62+
if( LAPACKE_lsame( uplo, 'u' ) ) {
63+
uplo_lapack = 'l';
64+
} else {
65+
uplo_lapack = 'u';
6066
}
6167
/* Allocate memory for work array(s) */
62-
if( LAPACKE_lsame( norm, 'i' ) ) {
63-
work_lapack = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,m) );
68+
if( LAPACKE_lsame( norm_lapack, 'i' ) ) {
69+
work_lapack = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,n) );
6470
if( work_lapack == NULL ) {
6571
info = LAPACK_WORK_MEMORY_ERROR;
66-
goto exit_level_1;
72+
goto exit_level_0;
6773
}
6874
}
69-
/* Transpose input matrices */
70-
LAPACKE_dtr_trans( matrix_layout, uplo, diag, MAX(m,n), a, lda, a_t, lda_t );
71-
/* Call LAPACK function and adjust info */
72-
res = LAPACK_dlantr( &norm, &uplo, &diag, &m, &n, a_t, &lda_t, work_lapack );
75+
/* Call LAPACK function */
76+
res = LAPACK_dlantr( &norm_lapack, &uplo_lapack, &diag, &n, &m, a, &lda, work_lapack );
7377
/* Release memory and exit */
7478
if( work_lapack ) {
7579
LAPACKE_free( work_lapack );
7680
}
77-
exit_level_1:
78-
LAPACKE_free( a_t );
7981
exit_level_0:
80-
if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
82+
if( info == LAPACK_WORK_MEMORY_ERROR ) {
8183
LAPACKE_xerbla( "LAPACKE_dlantr_work", info );
8284
}
8385
} else {

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

Lines changed: 20 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -40,44 +40,46 @@ float LAPACKE_slantr_work( int matrix_layout, char norm, char uplo,
4040
lapack_int info = 0;
4141
float res = 0.;
4242
if( matrix_layout == LAPACK_COL_MAJOR ) {
43-
/* Call LAPACK function and adjust info */
43+
/* Call LAPACK function */
4444
res = LAPACK_slantr( &norm, &uplo, &diag, &m, &n, a, &lda, work );
4545
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
46-
lapack_int lda_t = MAX(1,m);
47-
float* a_t = NULL;
4846
float* work_lapack = NULL;
47+
char norm_lapack;
48+
char uplo_lapack;
4949
/* Check leading dimension(s) */
5050
if( lda < n ) {
5151
info = -8;
5252
LAPACKE_xerbla( "LAPACKE_slantr_work", info );
5353
return info;
5454
}
55-
/* Allocate memory for temporary array(s) */
56-
a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,MAX(m,n)) );
57-
if( a_t == NULL ) {
58-
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
59-
goto exit_level_0;
55+
if( LAPACKE_lsame( norm, '1' ) || LAPACKE_lsame( norm, 'o' ) ) {
56+
norm_lapack = 'i';
57+
} else if( LAPACKE_lsame( norm, 'i' ) ) {
58+
norm_lapack = '1';
59+
} else {
60+
norm_lapack = norm;
61+
}
62+
if( LAPACKE_lsame( uplo, 'u' ) ) {
63+
uplo_lapack = 'l';
64+
} else {
65+
uplo_lapack = 'u';
6066
}
6167
/* Allocate memory for work array(s) */
62-
if( LAPACKE_lsame( norm, 'i' ) ) {
63-
work_lapack = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,m) );
68+
if( LAPACKE_lsame( norm_lapack, 'i' ) ) {
69+
work_lapack = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,n) );
6470
if( work_lapack == NULL ) {
6571
info = LAPACK_WORK_MEMORY_ERROR;
66-
goto exit_level_1;
72+
goto exit_level_0;
6773
}
6874
}
69-
/* Transpose input matrices */
70-
LAPACKE_str_trans( matrix_layout, uplo, diag, MAX(m,n), a, lda, a_t, lda_t );
71-
/* Call LAPACK function and adjust info */
72-
res = LAPACK_slantr( &norm, &uplo, &diag, &m, &n, a_t, &lda_t, work_lapack );
75+
/* Call LAPACK function */
76+
res = LAPACK_slantr( &norm_lapack, &uplo_lapack, &diag, &n, &m, a, &lda, work_lapack );
7377
/* Release memory and exit */
7478
if( work_lapack ) {
7579
LAPACKE_free( work_lapack );
7680
}
77-
exit_level_1:
78-
LAPACKE_free( a_t );
7981
exit_level_0:
80-
if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
82+
if( info == LAPACK_WORK_MEMORY_ERROR ) {
8183
LAPACKE_xerbla( "LAPACKE_slantr_work", info );
8284
}
8385
} else {

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

Lines changed: 20 additions & 19 deletions
Original file line numberDiff line numberDiff line change
@@ -41,45 +41,46 @@ double LAPACKE_zlantr_work( int matrix_layout, char norm, char uplo,
4141
lapack_int info = 0;
4242
double res = 0.;
4343
if( matrix_layout == LAPACK_COL_MAJOR ) {
44-
/* Call LAPACK function and adjust info */
44+
/* Call LAPACK function */
4545
res = LAPACK_zlantr( &norm, &uplo, &diag, &m, &n, a, &lda, work );
4646
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
47-
lapack_int lda_t = MAX(1,m);
48-
lapack_complex_double* a_t = NULL;
4947
double* work_lapack = NULL;
48+
char norm_lapack;
49+
char uplo_lapack;
5050
/* Check leading dimension(s) */
5151
if( lda < n ) {
5252
info = -8;
5353
LAPACKE_xerbla( "LAPACKE_zlantr_work", info );
5454
return info;
5555
}
56-
/* Allocate memory for temporary array(s) */
57-
a_t = (lapack_complex_double*)
58-
LAPACKE_malloc( sizeof(lapack_complex_double) * lda_t * MAX(1,MAX(m,n)) );
59-
if( a_t == NULL ) {
60-
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
61-
goto exit_level_0;
56+
if( LAPACKE_lsame( norm, '1' ) || LAPACKE_lsame( norm, 'o' ) ) {
57+
norm_lapack = 'i';
58+
} else if( LAPACKE_lsame( norm, 'i' ) ) {
59+
norm_lapack = '1';
60+
} else {
61+
norm_lapack = norm;
62+
}
63+
if( LAPACKE_lsame( uplo, 'u' ) ) {
64+
uplo_lapack = 'l';
65+
} else {
66+
uplo_lapack = 'u';
6267
}
6368
/* Allocate memory for work array(s) */
64-
if( LAPACKE_lsame( norm, 'i' ) ) {
65-
work_lapack = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,m) );
69+
if( LAPACKE_lsame( norm_lapack, 'i' ) ) {
70+
work_lapack = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,n) );
6671
if( work_lapack == NULL ) {
6772
info = LAPACK_WORK_MEMORY_ERROR;
68-
goto exit_level_1;
73+
goto exit_level_0;
6974
}
7075
}
71-
/* Transpose input matrices */
72-
LAPACKE_ztr_trans( matrix_layout, uplo, diag, MAX(m,n), a, lda, a_t, lda_t );
73-
/* Call LAPACK function and adjust info */
74-
res = LAPACK_zlantr( &norm, &uplo, &diag, &m, &n, a_t, &lda_t, work_lapack );
76+
/* Call LAPACK function */
77+
res = LAPACK_zlantr( &norm_lapack, &uplo_lapack, &diag, &n, &m, a, &lda, work_lapack );
7578
/* Release memory and exit */
7679
if( work_lapack ) {
7780
LAPACKE_free( work_lapack );
7881
}
79-
exit_level_1:
80-
LAPACKE_free( a_t );
8182
exit_level_0:
82-
if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
83+
if( info == LAPACK_WORK_MEMORY_ERROR ) {
8384
LAPACKE_xerbla( "LAPACKE_zlantr_work", info );
8485
}
8586
} else {

0 commit comments

Comments
 (0)