Skip to content

Commit ec0ae03

Browse files
martin-frbgmartin-frbg
authored
Merge pull request #3826 from martin-frbg/lapack540+725
Add a LAPACKE interface for ?LANGB and fix ?TPMQRT (Reference-LAPACK PR 540+725)
2 parents 76ae221 + 9fe75af commit ec0ae03

14 files changed

Lines changed: 722 additions & 48 deletions

‎cmake/lapacke.cmake‎

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -318,6 +318,8 @@ set(CSRC
318318
lapacke_clacn2.c
319319
lapacke_clag2z.c
320320
lapacke_clag2z_work.c
321+
lapacke_clangb.c
322+
lapacke_clangb_work.c
321323
lapacke_clange.c
322324
lapacke_clange_work.c
323325
lapacke_clanhe.c
@@ -803,6 +805,8 @@ set(DSRC
803805
lapacke_dlag2s_work.c
804806
lapacke_dlamch.c
805807
lapacke_dlamch_work.c
808+
lapacke_dlangb.c
809+
lapacke_dlangb_work.c
806810
lapacke_dlange.c
807811
lapacke_dlange_work.c
808812
lapacke_dlansy.c
@@ -1381,6 +1385,8 @@ set(SSRC
13811385
lapacke_slag2d_work.c
13821386
lapacke_slamch.c
13831387
lapacke_slamch_work.c
1388+
lapacke_slangb.c
1389+
lapacke_slangb_work.c
13841390
lapacke_slange.c
13851391
lapacke_slange_work.c
13861392
lapacke_slansy.c
@@ -2089,6 +2095,8 @@ set(ZSRC
20892095
lapacke_zlacrm_work.c
20902096
lapacke_zlag2c.c
20912097
lapacke_zlag2c_work.c
2098+
lapacke_zlangb.c
2099+
lapacke_zlangb_work.c
20922100
lapacke_zlange.c
20932101
lapacke_zlange_work.c
20942102
lapacke_zlanhe.c

‎lapack-netlib/LAPACKE/src/Makefile‎

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -358,6 +358,8 @@ lapacke_clacrm.o \
358358
lapacke_clacrm_work.o \
359359
lapacke_clag2z.o \
360360
lapacke_clag2z_work.o \
361+
lapacke_clangb.o \
362+
lapacke_clangb_work.o \
361363
lapacke_clange.o \
362364
lapacke_clange_work.o \
363365
lapacke_clanhe.o \
@@ -842,6 +844,8 @@ lapacke_dlag2s.o \
842844
lapacke_dlag2s_work.o \
843845
lapacke_dlamch.o \
844846
lapacke_dlamch_work.o \
847+
lapacke_dlangb.o \
848+
lapacke_dlangb_work.o \
845849
lapacke_dlange.o \
846850
lapacke_dlange_work.o \
847851
lapacke_dlansy.o \
@@ -1414,6 +1418,8 @@ lapacke_slacpy.o \
14141418
lapacke_slacpy_work.o \
14151419
lapacke_slamch.o \
14161420
lapacke_slamch_work.o \
1421+
lapacke_slangb.o \
1422+
lapacke_slangb_work.o \
14171423
lapacke_slange.o \
14181424
lapacke_slange_work.o \
14191425
lapacke_slansy.o \
@@ -2116,6 +2122,8 @@ lapacke_zlacrm.o \
21162122
lapacke_zlacrm_work.o \
21172123
lapacke_zlag2c.o \
21182124
lapacke_zlag2c_work.o \
2125+
lapacke_zlangb.o \
2126+
lapacke_zlangb_work.o \
21192127
lapacke_zlange.o \
21202128
lapacke_zlange_work.o \
21212129
lapacke_zlanhe.o \

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

Lines changed: 73 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,73 @@
1+
/*****************************************************************************
2+
Copyright (c) 2022, Intel Corp.
3+
All rights reserved.
4+
5+
Redistribution and use in source and binary forms, with or without
6+
modification, are permitted provided that the following conditions are met:
7+
8+
* Redistributions of source code must retain the above copyright notice,
9+
this list of conditions and the following disclaimer.
10+
* Redistributions in binary form must reproduce the above copyright
11+
notice, this list of conditions and the following disclaimer in the
12+
documentation and/or other materials provided with the distribution.
13+
* Neither the name of Intel Corporation nor the names of its contributors
14+
may be used to endorse or promote products derived from this software
15+
without specific prior written permission.
16+
17+
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
18+
AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
19+
IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
20+
ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
21+
LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
22+
CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
23+
SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
24+
INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
25+
CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
26+
ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
27+
THE POSSIBILITY OF SUCH DAMAGE.
28+
*****************************************************************************
29+
* Contents: Native high-level C interface to LAPACK function clangb
30+
* Author: Simon Märtens
31+
*****************************************************************************/
32+
33+
#include "lapacke_utils.h"
34+
35+
float LAPACKE_clangb( int matrix_layout, char norm, lapack_int n,
36+
lapack_int kl, lapack_int ku,
37+
const lapack_complex_float* ab, lapack_int ldab )
38+
{
39+
lapack_int info = 0;
40+
float res = 0.;
41+
float* work = NULL;
42+
if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
43+
LAPACKE_xerbla( "LAPACKE_clangb", -1 );
44+
return -1;
45+
}
46+
#ifndef LAPACK_DISABLE_NAN_CHECK
47+
if( LAPACKE_get_nancheck() ) {
48+
/* Optionally check input matrices for NaNs */
49+
if( LAPACKE_cgb_nancheck( matrix_layout, n, n, kl, ku, ab, ldab ) ) {
50+
return -6;
51+
}
52+
}
53+
#endif
54+
/* Allocate memory for working array(s) */
55+
if( LAPACKE_lsame( norm, 'i' ) ) {
56+
work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,n) );
57+
if( work == NULL ) {
58+
info = LAPACK_WORK_MEMORY_ERROR;
59+
goto exit_level_0;
60+
}
61+
}
62+
/* Call middle-level interface */
63+
res = LAPACKE_clangb_work( matrix_layout, norm, n, kl, ku, ab, ldab, work );
64+
/* Release memory and exit */
65+
if( LAPACKE_lsame( norm, 'i' ) ) {
66+
LAPACKE_free( work );
67+
}
68+
exit_level_0:
69+
if( info == LAPACK_WORK_MEMORY_ERROR ) {
70+
LAPACKE_xerbla( "LAPACKE_clangb", info );
71+
}
72+
return res;
73+
}

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

Lines changed: 84 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,84 @@
1+
/*****************************************************************************
2+
Copyright (c) 2022, Intel Corp.
3+
All rights reserved.
4+
5+
Redistribution and use in source and binary forms, with or without
6+
modification, are permitted provided that the following conditions are met:
7+
8+
* Redistributions of source code must retain the above copyright notice,
9+
this list of conditions and the following disclaimer.
10+
* Redistributions in binary form must reproduce the above copyright
11+
notice, this list of conditions and the following disclaimer in the
12+
documentation and/or other materials provided with the distribution.
13+
* Neither the name of Intel Corporation nor the names of its contributors
14+
may be used to endorse or promote products derived from this software
15+
without specific prior written permission.
16+
17+
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
18+
AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
19+
IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
20+
ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
21+
LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
22+
CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
23+
SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
24+
INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
25+
CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
26+
ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
27+
THE POSSIBILITY OF SUCH DAMAGE.
28+
*****************************************************************************
29+
* Contents: Native middle-level C interface to LAPACK function clangb
30+
* Author: Simon Märtens
31+
*****************************************************************************/
32+
33+
#include "lapacke_utils.h"
34+
35+
float LAPACKE_clangb_work( int matrix_layout, char norm, lapack_int n,
36+
lapack_int kl, lapack_int ku,
37+
const lapack_complex_float* ab, lapack_int ldab,
38+
float* work )
39+
{
40+
lapack_int info = 0;
41+
float res = 0.;
42+
if( matrix_layout == LAPACK_COL_MAJOR ) {
43+
/* Call LAPACK function and adjust info */
44+
res = LAPACK_clangb( &norm, &n, &kl, &ku, ab, &ldab, work );
45+
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
46+
char norm_lapack;
47+
float* work_lapack = NULL;
48+
/* Check leading dimension(s) */
49+
if( ldab < kl+ku+1 ) {
50+
info = -7;
51+
LAPACKE_xerbla( "LAPACKE_clangb_work", info );
52+
return info;
53+
}
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+
}
68+
}
69+
/* Call LAPACK function */
70+
res = LAPACK_clangb( &norm, &n, &ku, &kl, ab, &ldab, work );
71+
/* Release memory and exit */
72+
if( work_lapack ) {
73+
LAPACKE_free( work_lapack );
74+
}
75+
exit_level_0:
76+
if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
77+
LAPACKE_xerbla( "LAPACKE_clangb_work", info );
78+
}
79+
} else {
80+
info = -1;
81+
LAPACKE_xerbla( "LAPACKE_clangb_work", info );
82+
}
83+
return res;
84+
}

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

Lines changed: 20 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -50,16 +50,24 @@ lapack_int LAPACKE_ctpmqrt_work( int matrix_layout, char side, char trans,
5050
info = info - 1;
5151
}
5252
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
53-
lapack_int lda_t = MAX(1,k);
53+
lapack_int nrowsA, ncolsA, nrowsV;
54+
if ( side == LAPACKE_lsame(side, 'l') ) { nrowsA = k; ncolsA = n; nrowsV = m; }
55+
else if ( side == LAPACKE_lsame(side, 'r') ) { nrowsA = m; ncolsA = k; nrowsV = n; }
56+
else {
57+
info = -2;
58+
LAPACKE_xerbla( "LAPACKE_ctpmqrt_work", info );
59+
return info;
60+
}
61+
lapack_int lda_t = MAX(1,nrowsA);
5462
lapack_int ldb_t = MAX(1,m);
55-
lapack_int ldt_t = MAX(1,ldt);
56-
lapack_int ldv_t = MAX(1,ldv);
63+
lapack_int ldt_t = MAX(1,nb);
64+
lapack_int ldv_t = MAX(1,nrowsV);
5765
lapack_complex_float* v_t = NULL;
5866
lapack_complex_float* t_t = NULL;
5967
lapack_complex_float* a_t = NULL;
6068
lapack_complex_float* b_t = NULL;
6169
/* Check leading dimension(s) */
62-
if( lda < m ) {
70+
if( lda < ncolsA ) {
6371
info = -14;
6472
LAPACKE_xerbla( "LAPACKE_ctpmqrt_work", info );
6573
return info;
@@ -69,7 +77,7 @@ lapack_int LAPACKE_ctpmqrt_work( int matrix_layout, char side, char trans,
6977
LAPACKE_xerbla( "LAPACKE_ctpmqrt_work", info );
7078
return info;
7179
}
72-
if( ldt < nb ) {
80+
if( ldt < k ) {
7381
info = -12;
7482
LAPACKE_xerbla( "LAPACKE_ctpmqrt_work", info );
7583
return info;
@@ -87,13 +95,13 @@ lapack_int LAPACKE_ctpmqrt_work( int matrix_layout, char side, char trans,
8795
goto exit_level_0;
8896
}
8997
t_t = (lapack_complex_float*)
90-
LAPACKE_malloc( sizeof(lapack_complex_float) * ldt_t * MAX(1,nb) );
98+
LAPACKE_malloc( sizeof(lapack_complex_float) * ldt_t * MAX(1,k) );
9199
if( t_t == NULL ) {
92100
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
93101
goto exit_level_1;
94102
}
95103
a_t = (lapack_complex_float*)
96-
LAPACKE_malloc( sizeof(lapack_complex_float) * lda_t * MAX(1,m) );
104+
LAPACKE_malloc( sizeof(lapack_complex_float) * lda_t * MAX(1,ncolsA) );
97105
if( a_t == NULL ) {
98106
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
99107
goto exit_level_2;
@@ -105,18 +113,18 @@ lapack_int LAPACKE_ctpmqrt_work( int matrix_layout, char side, char trans,
105113
goto exit_level_3;
106114
}
107115
/* Transpose input matrices */
108-
LAPACKE_cge_trans( matrix_layout, ldv, k, v, ldv, v_t, ldv_t );
109-
LAPACKE_cge_trans( matrix_layout, ldt, nb, t, ldt, t_t, ldt_t );
110-
LAPACKE_cge_trans( matrix_layout, k, m, a, lda, a_t, lda_t );
111-
LAPACKE_cge_trans( matrix_layout, m, n, b, ldb, b_t, ldb_t );
116+
LAPACKE_cge_trans( LAPACK_ROW_MAJOR, nrowsV, k, v, ldv, v_t, ldv_t );
117+
LAPACKE_cge_trans( LAPACK_ROW_MAJOR, nb, k, t, ldt, t_t, ldt_t );
118+
LAPACKE_cge_trans( LAPACK_ROW_MAJOR, nrowsA, ncolsA, a, lda, a_t, lda_t );
119+
LAPACKE_cge_trans( LAPACK_ROW_MAJOR, m, n, b, ldb, b_t, ldb_t );
112120
/* Call LAPACK function and adjust info */
113121
LAPACK_ctpmqrt( &side, &trans, &m, &n, &k, &l, &nb, v_t, &ldv_t, t_t,
114122
&ldt_t, a_t, &lda_t, b_t, &ldb_t, work, &info );
115123
if( info < 0 ) {
116124
info = info - 1;
117125
}
118126
/* Transpose output matrices */
119-
LAPACKE_cge_trans( LAPACK_COL_MAJOR, k, m, a_t, lda_t, a, lda );
127+
LAPACKE_cge_trans( LAPACK_COL_MAJOR, nrowsA, ncolsA, a_t, lda_t, a, lda );
120128
LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb );
121129
/* Release memory and exit */
122130
LAPACKE_free( b_t );

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

Lines changed: 73 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,73 @@
1+
/*****************************************************************************
2+
Copyright (c) 2022, Intel Corp.
3+
All rights reserved.
4+
5+
Redistribution and use in source and binary forms, with or without
6+
modification, are permitted provided that the following conditions are met:
7+
8+
* Redistributions of source code must retain the above copyright notice,
9+
this list of conditions and the following disclaimer.
10+
* Redistributions in binary form must reproduce the above copyright
11+
notice, this list of conditions and the following disclaimer in the
12+
documentation and/or other materials provided with the distribution.
13+
* Neither the name of Intel Corporation nor the names of its contributors
14+
may be used to endorse or promote products derived from this software
15+
without specific prior written permission.
16+
17+
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
18+
AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
19+
IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
20+
ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
21+
LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
22+
CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
23+
SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
24+
INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
25+
CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
26+
ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
27+
THE POSSIBILITY OF SUCH DAMAGE.
28+
*****************************************************************************
29+
* Contents: Native high-level C interface to LAPACK function dlangb
30+
* Author: Simon Märtens
31+
*****************************************************************************/
32+
33+
#include "lapacke_utils.h"
34+
35+
double LAPACKE_dlangb( int matrix_layout, char norm, lapack_int n,
36+
lapack_int kl, lapack_int ku, const double* ab,
37+
lapack_int ldab )
38+
{
39+
lapack_int info = 0;
40+
double res = 0.;
41+
double* work = NULL;
42+
if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
43+
LAPACKE_xerbla( "LAPACKE_dlangb", -1 );
44+
return -1;
45+
}
46+
#ifndef LAPACK_DISABLE_NAN_CHECK
47+
if( LAPACKE_get_nancheck() ) {
48+
/* Optionally check input matrices for NaNs */
49+
if( LAPACKE_dgb_nancheck( matrix_layout, n, n, kl, ku, ab, ldab ) ) {
50+
return -6;
51+
}
52+
}
53+
#endif
54+
/* Allocate memory for working array(s) */
55+
if( LAPACKE_lsame( norm, 'i' ) ) {
56+
work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,n) );
57+
if( work == NULL ) {
58+
info = LAPACK_WORK_MEMORY_ERROR;
59+
goto exit_level_0;
60+
}
61+
}
62+
/* Call middle-level interface */
63+
res = LAPACKE_dlangb_work( matrix_layout, norm, n, kl, ku, ab, ldab, work );
64+
/* Release memory and exit */
65+
if( LAPACKE_lsame( norm, 'i' ) ) {
66+
LAPACKE_free( work );
67+
}
68+
exit_level_0:
69+
if( info == LAPACK_WORK_MEMORY_ERROR ) {
70+
LAPACKE_xerbla( "LAPACKE_dlangb", info );
71+
}
72+
return res;
73+
}

0 commit comments

Comments
 (0)