Skip to content

Commit fc8d962

Browse files
langoulangou
authored
Merge pull request #154 from echeresh/xlange_lapacke
Avoid conversion between layouts in lapacke_?lange_work
2 parents a1e853b + fc1681d commit fc8d962

4 files changed

Lines changed: 92 additions & 74 deletions

File tree

‎LAPACKE/src/lapacke_clange_work.c‎

Lines changed: 23 additions & 19 deletions
Original file line numberDiff line numberDiff line change
@@ -39,37 +39,41 @@ float LAPACKE_clange_work( int matrix_layout, char norm, lapack_int m,
3939
{
4040
lapack_int info = 0;
4141
float res = 0.;
42+
char norm_lapack;
4243
if( matrix_layout == LAPACK_COL_MAJOR ) {
43-
/* Call LAPACK function and adjust info */
44+
/* Call LAPACK function */
4445
res = LAPACK_clange( &norm, &m, &n, a, &lda, work );
45-
if( info < 0 ) {
46-
info = info - 1;
47-
}
4846
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
49-
lapack_int lda_t = MAX(1,m);
50-
lapack_complex_float* a_t = NULL;
47+
float* work_lapack = NULL;
5148
/* Check leading dimension(s) */
5249
if( lda < n ) {
5350
info = -6;
5451
LAPACKE_xerbla( "LAPACKE_clange_work", info );
5552
return info;
5653
}
57-
/* Allocate memory for temporary array(s) */
58-
a_t = (lapack_complex_float*)
59-
LAPACKE_malloc( sizeof(lapack_complex_float) * lda_t * MAX(1,n) );
60-
if( a_t == NULL ) {
61-
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
62-
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+
/* Allocate memory for work array(s) */
62+
if( LAPACKE_lsame( norm_lapack, 'i' ) ) {
63+
work_lapack = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,n) );
64+
if( work_lapack == NULL ) {
65+
info = LAPACK_WORK_MEMORY_ERROR;
66+
goto exit_level_0;
67+
}
6368
}
64-
/* Transpose input matrices */
65-
LAPACKE_cge_trans( matrix_layout, m, n, a, lda, a_t, lda_t );
66-
/* Call LAPACK function and adjust info */
67-
res = LAPACK_clange( &norm, &m, &n, a_t, &lda_t, work );
68-
info = 0; /* LAPACK call is ok! */
69+
/* Call LAPACK function */
70+
res = LAPACK_clange( &norm_lapack, &n, &m, a, &lda, work_lapack );
6971
/* Release memory and exit */
70-
LAPACKE_free( a_t );
72+
if( work_lapack ) {
73+
LAPACKE_free( work_lapack );
74+
}
7175
exit_level_0:
72-
if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
76+
if( info == LAPACK_WORK_MEMORY_ERROR ) {
7377
LAPACKE_xerbla( "LAPACKE_clange_work", info );
7478
}
7579
} else {

‎LAPACKE/src/lapacke_dlange_work.c‎

Lines changed: 23 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -39,36 +39,41 @@ double LAPACKE_dlange_work( int matrix_layout, char norm, lapack_int m,
3939
{
4040
lapack_int info = 0;
4141
double res = 0.;
42+
char norm_lapack;
4243
if( matrix_layout == LAPACK_COL_MAJOR ) {
43-
/* Call LAPACK function and adjust info */
44+
/* Call LAPACK function */
4445
res = LAPACK_dlange( &norm, &m, &n, a, &lda, work );
45-
if( info < 0 ) {
46-
info = info - 1;
47-
}
4846
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
49-
lapack_int lda_t = MAX(1,m);
50-
double* a_t = NULL;
47+
double* work_lapack = NULL;
5148
/* Check leading dimension(s) */
5249
if( lda < n ) {
5350
info = -6;
5451
LAPACKE_xerbla( "LAPACKE_dlange_work", info );
5552
return info;
5653
}
57-
/* Allocate memory for temporary array(s) */
58-
a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
59-
if( a_t == NULL ) {
60-
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
61-
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+
/* Allocate memory for work array(s) */
62+
if( LAPACKE_lsame( norm_lapack, 'i' ) ) {
63+
work_lapack = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,n) );
64+
if( work_lapack == NULL ) {
65+
info = LAPACK_WORK_MEMORY_ERROR;
66+
goto exit_level_0;
67+
}
6268
}
63-
/* Transpose input matrices */
64-
LAPACKE_dge_trans( matrix_layout, m, n, a, lda, a_t, lda_t );
65-
/* Call LAPACK function and adjust info */
66-
res = LAPACK_dlange( &norm, &m, &n, a_t, &lda_t, work );
67-
info = 0; /* LAPACK call is ok! */
69+
/* Call LAPACK function */
70+
res = LAPACK_dlange( &norm_lapack, &n, &m, a, &lda, work_lapack );
6871
/* Release memory and exit */
69-
LAPACKE_free( a_t );
72+
if( work_lapack ) {
73+
LAPACKE_free( work_lapack );
74+
}
7075
exit_level_0:
71-
if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
76+
if( info == LAPACK_WORK_MEMORY_ERROR ) {
7277
LAPACKE_xerbla( "LAPACKE_dlange_work", info );
7378
}
7479
} else {

‎LAPACKE/src/lapacke_slange_work.c‎

Lines changed: 23 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -39,36 +39,41 @@ float LAPACKE_slange_work( int matrix_layout, char norm, lapack_int m,
3939
{
4040
lapack_int info = 0;
4141
float res = 0.;
42+
char norm_lapack;
4243
if( matrix_layout == LAPACK_COL_MAJOR ) {
43-
/* Call LAPACK function and adjust info */
44+
/* Call LAPACK function */
4445
res = LAPACK_slange( &norm, &m, &n, a, &lda, work );
45-
if( info < 0 ) {
46-
info = info - 1;
47-
}
4846
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
49-
lapack_int lda_t = MAX(1,m);
50-
float* a_t = NULL;
47+
float* work_lapack = NULL;
5148
/* Check leading dimension(s) */
5249
if( lda < n ) {
5350
info = -6;
5451
LAPACKE_xerbla( "LAPACKE_slange_work", info );
5552
return info;
5653
}
57-
/* Allocate memory for temporary array(s) */
58-
a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
59-
if( a_t == NULL ) {
60-
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
61-
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+
/* Allocate memory for work array(s) */
62+
if( LAPACKE_lsame( norm_lapack, 'i' ) ) {
63+
work_lapack = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,n) );
64+
if( work_lapack == NULL ) {
65+
info = LAPACK_WORK_MEMORY_ERROR;
66+
goto exit_level_0;
67+
}
6268
}
63-
/* Transpose input matrices */
64-
LAPACKE_sge_trans( matrix_layout, m, n, a, lda, a_t, lda_t );
65-
/* Call LAPACK function and adjust info */
66-
res = LAPACK_slange( &norm, &m, &n, a_t, &lda_t, work );
67-
info = 0; /* LAPACK call is ok! */
69+
/* Call LAPACK function */
70+
res = LAPACK_slange( &norm_lapack, &n, &m, a, &lda, work_lapack );
6871
/* Release memory and exit */
69-
LAPACKE_free( a_t );
72+
if( work_lapack ) {
73+
LAPACKE_free( work_lapack );
74+
}
7075
exit_level_0:
71-
if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
76+
if( info == LAPACK_WORK_MEMORY_ERROR ) {
7277
LAPACKE_xerbla( "LAPACKE_slange_work", info );
7378
}
7479
} else {

‎LAPACKE/src/lapacke_zlange_work.c‎

Lines changed: 23 additions & 19 deletions
Original file line numberDiff line numberDiff line change
@@ -39,37 +39,41 @@ double LAPACKE_zlange_work( int matrix_layout, char norm, lapack_int m,
3939
{
4040
lapack_int info = 0;
4141
double res = 0.;
42+
char norm_lapack;
4243
if( matrix_layout == LAPACK_COL_MAJOR ) {
43-
/* Call LAPACK function and adjust info */
44+
/* Call LAPACK function */
4445
res = LAPACK_zlange( &norm, &m, &n, a, &lda, work );
45-
if( info < 0 ) {
46-
info = info - 1;
47-
}
4846
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
49-
lapack_int lda_t = MAX(1,m);
50-
lapack_complex_double* a_t = NULL;
47+
double* work_lapack = NULL;
5148
/* Check leading dimension(s) */
5249
if( lda < n ) {
5350
info = -6;
5451
LAPACKE_xerbla( "LAPACKE_zlange_work", info );
5552
return info;
5653
}
57-
/* Allocate memory for temporary array(s) */
58-
a_t = (lapack_complex_double*)
59-
LAPACKE_malloc( sizeof(lapack_complex_double) * lda_t * MAX(1,n) );
60-
if( a_t == NULL ) {
61-
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
62-
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+
/* Allocate memory for work array(s) */
62+
if( LAPACKE_lsame( norm_lapack, 'i' ) ) {
63+
work_lapack = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,n) );
64+
if( work_lapack == NULL ) {
65+
info = LAPACK_WORK_MEMORY_ERROR;
66+
goto exit_level_0;
67+
}
6368
}
64-
/* Transpose input matrices */
65-
LAPACKE_zge_trans( matrix_layout, m, n, a, lda, a_t, lda_t );
66-
/* Call LAPACK function and adjust info */
67-
res = LAPACK_zlange( &norm, &m, &n, a_t, &lda_t, work );
68-
info = 0; /* LAPACK call is ok! */
69+
/* Call LAPACK function */
70+
res = LAPACK_zlange( &norm_lapack, &n, &m, a, &lda, work_lapack );
6971
/* Release memory and exit */
70-
LAPACKE_free( a_t );
72+
if( work_lapack ) {
73+
LAPACKE_free( work_lapack );
74+
}
7175
exit_level_0:
72-
if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
76+
if( info == LAPACK_WORK_MEMORY_ERROR ) {
7377
LAPACKE_xerbla( "LAPACKE_zlange_work", info );
7478
}
7579
} else {

0 commit comments

Comments
 (0)