Skip to content

Commit 77a0ceb

Browse files
julielangoujulielangou
authored
Merge pull request #382 from vladimir-ch/lapacke/dlantr-no-alloc-trans
LAPACKE: don't allocate transposed matrix in ?lantr_work
2 parents 661d60c + fd8f680 commit 77a0ceb

4 files changed

Lines changed: 80 additions & 74 deletions

File tree

‎LAPACKE/src/lapacke_clantr_work.c‎

Lines changed: 20 additions & 19 deletions
Original file line numberDiff line numberDiff line change
@@ -40,45 +40,46 @@ float LAPACKE_clantr_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_clantr( &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-
lapack_complex_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_clantr_work", info );
5353
return info;
5454
}
55-
/* Allocate memory for temporary array(s) */
56-
a_t = (lapack_complex_float*)
57-
LAPACKE_malloc( sizeof(lapack_complex_float) * lda_t * MAX(1,MAX(m,n)) );
58-
if( a_t == NULL ) {
59-
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
60-
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';
6166
}
6267
/* Allocate memory for work array(s) */
63-
if( LAPACKE_lsame( norm, 'i' ) ) {
64-
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) );
6570
if( work_lapack == NULL ) {
6671
info = LAPACK_WORK_MEMORY_ERROR;
67-
goto exit_level_1;
72+
goto exit_level_0;
6873
}
6974
}
70-
/* Transpose input matrices */
71-
LAPACKE_ctr_trans( matrix_layout, uplo, diag, MAX(m,n), a, lda, a_t, lda_t );
72-
/* Call LAPACK function and adjust info */
73-
res = LAPACK_clantr( &norm, &uplo, &diag, &m, &n, a_t, &lda_t, work_lapack );
75+
/* Call LAPACK function */
76+
res = LAPACK_clantr( &norm_lapack, &uplo_lapack, &diag, &n, &m, a, &lda, work_lapack );
7477
/* Release memory and exit */
7578
if( work_lapack ) {
7679
LAPACKE_free( work_lapack );
7780
}
78-
exit_level_1:
79-
LAPACKE_free( a_t );
8081
exit_level_0:
81-
if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
82+
if( info == LAPACK_WORK_MEMORY_ERROR ) {
8283
LAPACKE_xerbla( "LAPACKE_clantr_work", info );
8384
}
8485
} else {

‎LAPACKE/src/lapacke_dlantr_work.c‎

Lines changed: 20 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -39,44 +39,46 @@ double LAPACKE_dlantr_work( int matrix_layout, char norm, char uplo,
3939
lapack_int info = 0;
4040
double res = 0.;
4141
if( matrix_layout == LAPACK_COL_MAJOR ) {
42-
/* Call LAPACK function and adjust info */
42+
/* Call LAPACK function */
4343
res = LAPACK_dlantr( &norm, &uplo, &diag, &m, &n, a, &lda, work );
4444
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
45-
lapack_int lda_t = MAX(1,m);
46-
double* a_t = NULL;
4745
double* work_lapack = NULL;
46+
char norm_lapack;
47+
char uplo_lapack;
4848
/* Check leading dimension(s) */
4949
if( lda < n ) {
5050
info = -8;
5151
LAPACKE_xerbla( "LAPACKE_dlantr_work", info );
5252
return info;
5353
}
54-
/* Allocate memory for temporary array(s) */
55-
a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,MAX(m,n)) );
56-
if( a_t == NULL ) {
57-
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
58-
goto exit_level_0;
54+
if( LAPACKE_lsame( norm, '1' ) || LAPACKE_lsame( norm, 'o' ) ) {
55+
norm_lapack = 'i';
56+
} else if( LAPACKE_lsame( norm, 'i' ) ) {
57+
norm_lapack = '1';
58+
} else {
59+
norm_lapack = norm;
60+
}
61+
if( LAPACKE_lsame( uplo, 'u' ) ) {
62+
uplo_lapack = 'l';
63+
} else {
64+
uplo_lapack = 'u';
5965
}
6066
/* Allocate memory for work array(s) */
61-
if( LAPACKE_lsame( norm, 'i' ) ) {
62-
work_lapack = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,m) );
67+
if( LAPACKE_lsame( norm_lapack, 'i' ) ) {
68+
work_lapack = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,n) );
6369
if( work_lapack == NULL ) {
6470
info = LAPACK_WORK_MEMORY_ERROR;
65-
goto exit_level_1;
71+
goto exit_level_0;
6672
}
6773
}
68-
/* Transpose input matrices */
69-
LAPACKE_dtr_trans( matrix_layout, uplo, diag, MAX(m,n), a, lda, a_t, lda_t );
70-
/* Call LAPACK function and adjust info */
71-
res = LAPACK_dlantr( &norm, &uplo, &diag, &m, &n, a_t, &lda_t, work_lapack );
74+
/* Call LAPACK function */
75+
res = LAPACK_dlantr( &norm_lapack, &uplo_lapack, &diag, &n, &m, a, &lda, work_lapack );
7276
/* Release memory and exit */
7377
if( work_lapack ) {
7478
LAPACKE_free( work_lapack );
7579
}
76-
exit_level_1:
77-
LAPACKE_free( a_t );
7880
exit_level_0:
79-
if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
81+
if( info == LAPACK_WORK_MEMORY_ERROR ) {
8082
LAPACKE_xerbla( "LAPACKE_dlantr_work", info );
8183
}
8284
} else {

‎LAPACKE/src/lapacke_slantr_work.c‎

Lines changed: 20 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -39,44 +39,46 @@ float LAPACKE_slantr_work( int matrix_layout, char norm, char uplo,
3939
lapack_int info = 0;
4040
float res = 0.;
4141
if( matrix_layout == LAPACK_COL_MAJOR ) {
42-
/* Call LAPACK function and adjust info */
42+
/* Call LAPACK function */
4343
res = LAPACK_slantr( &norm, &uplo, &diag, &m, &n, a, &lda, work );
4444
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
45-
lapack_int lda_t = MAX(1,m);
46-
float* a_t = NULL;
4745
float* work_lapack = NULL;
46+
char norm_lapack;
47+
char uplo_lapack;
4848
/* Check leading dimension(s) */
4949
if( lda < n ) {
5050
info = -8;
5151
LAPACKE_xerbla( "LAPACKE_slantr_work", info );
5252
return info;
5353
}
54-
/* Allocate memory for temporary array(s) */
55-
a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,MAX(m,n)) );
56-
if( a_t == NULL ) {
57-
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
58-
goto exit_level_0;
54+
if( LAPACKE_lsame( norm, '1' ) || LAPACKE_lsame( norm, 'o' ) ) {
55+
norm_lapack = 'i';
56+
} else if( LAPACKE_lsame( norm, 'i' ) ) {
57+
norm_lapack = '1';
58+
} else {
59+
norm_lapack = norm;
60+
}
61+
if( LAPACKE_lsame( uplo, 'u' ) ) {
62+
uplo_lapack = 'l';
63+
} else {
64+
uplo_lapack = 'u';
5965
}
6066
/* Allocate memory for work array(s) */
61-
if( LAPACKE_lsame( norm, 'i' ) ) {
62-
work_lapack = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,m) );
67+
if( LAPACKE_lsame( norm_lapack, 'i' ) ) {
68+
work_lapack = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,n) );
6369
if( work_lapack == NULL ) {
6470
info = LAPACK_WORK_MEMORY_ERROR;
65-
goto exit_level_1;
71+
goto exit_level_0;
6672
}
6773
}
68-
/* Transpose input matrices */
69-
LAPACKE_str_trans( matrix_layout, uplo, diag, MAX(m,n), a, lda, a_t, lda_t );
70-
/* Call LAPACK function and adjust info */
71-
res = LAPACK_slantr( &norm, &uplo, &diag, &m, &n, a_t, &lda_t, work_lapack );
74+
/* Call LAPACK function */
75+
res = LAPACK_slantr( &norm_lapack, &uplo_lapack, &diag, &n, &m, a, &lda, work_lapack );
7276
/* Release memory and exit */
7377
if( work_lapack ) {
7478
LAPACKE_free( work_lapack );
7579
}
76-
exit_level_1:
77-
LAPACKE_free( a_t );
7880
exit_level_0:
79-
if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
81+
if( info == LAPACK_WORK_MEMORY_ERROR ) {
8082
LAPACKE_xerbla( "LAPACKE_slantr_work", info );
8183
}
8284
} else {

‎LAPACKE/src/lapacke_zlantr_work.c‎

Lines changed: 20 additions & 19 deletions
Original file line numberDiff line numberDiff line change
@@ -40,45 +40,46 @@ double LAPACKE_zlantr_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_zlantr( &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-
lapack_complex_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_zlantr_work", info );
5353
return info;
5454
}
55-
/* Allocate memory for temporary array(s) */
56-
a_t = (lapack_complex_double*)
57-
LAPACKE_malloc( sizeof(lapack_complex_double) * lda_t * MAX(1,MAX(m,n)) );
58-
if( a_t == NULL ) {
59-
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
60-
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';
6166
}
6267
/* Allocate memory for work array(s) */
63-
if( LAPACKE_lsame( norm, 'i' ) ) {
64-
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) );
6570
if( work_lapack == NULL ) {
6671
info = LAPACK_WORK_MEMORY_ERROR;
67-
goto exit_level_1;
72+
goto exit_level_0;
6873
}
6974
}
70-
/* Transpose input matrices */
71-
LAPACKE_ztr_trans( matrix_layout, uplo, diag, MAX(m,n), a, lda, a_t, lda_t );
72-
/* Call LAPACK function and adjust info */
73-
res = LAPACK_zlantr( &norm, &uplo, &diag, &m, &n, a_t, &lda_t, work_lapack );
75+
/* Call LAPACK function */
76+
res = LAPACK_zlantr( &norm_lapack, &uplo_lapack, &diag, &n, &m, a, &lda, work_lapack );
7477
/* Release memory and exit */
7578
if( work_lapack ) {
7679
LAPACKE_free( work_lapack );
7780
}
78-
exit_level_1:
79-
LAPACKE_free( a_t );
8081
exit_level_0:
81-
if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
82+
if( info == LAPACK_WORK_MEMORY_ERROR ) {
8283
LAPACKE_xerbla( "LAPACKE_zlantr_work", info );
8384
}
8485
} else {

0 commit comments

Comments
 (0)