Skip to content

Commit 88c205c

Browse files
martin-frbgmartin-frbg
authored
Merge pull request #4047 from martin-frbg/lapack827
Add LAPACKE interfaces for [CZ]UNHR_COL and [SD]ORHR_COL (Reference-LAPACK PR 827)
2 parents 941a34b + a789211 commit 88c205c

13 files changed

+463
-1
lines changed

‎cmake/lapacke.cmake

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -590,6 +590,8 @@ set(CSRC
590590
lapacke_cungtr_work.c
591591
lapacke_cungtsqr_row.c
592592
lapacke_cungtsqr_row_work.c
593+
lapacke_cunhr_col.c
594+
lapacke_cunhr_col_work.c
593595
lapacke_cunmbr.c
594596
lapacke_cunmbr_work.c
595597
lapacke_cunmhr.c
@@ -862,6 +864,8 @@ set(DSRC
862864
lapacke_dorgtr_work.c
863865
lapacke_dorgtsqr_row.c
864866
lapacke_dorgtsqr_row_work.c
867+
lapacke_dorhr_col.c
868+
lapacke_dorhr_col_work.c
865869
lapacke_dormbr.c
866870
lapacke_dormbr_work.c
867871
lapacke_dormhr.c
@@ -1435,6 +1439,8 @@ set(SSRC
14351439
lapacke_sorgtr_work.c
14361440
lapacke_sorgtsqr_row.c
14371441
lapacke_sorgtsqr_row_work.c
1442+
lapacke_sorhr_col.c
1443+
lapacke_sorhr_col_work.c
14381444
lapacke_sormbr.c
14391445
lapacke_sormbr_work.c
14401446
lapacke_sormhr.c
@@ -2351,6 +2357,8 @@ set(ZSRC
23512357
lapacke_zungtr_work.c
23522358
lapacke_zungtsqr_row.c
23532359
lapacke_zungtsqr_row_work.c
2360+
lapacke_zunhr_col.c
2361+
lapacke_zunhr_col_work.c
23542362
lapacke_zunmbr.c
23552363
lapacke_zunmbr_work.c
23562364
lapacke_zunmhr.c

‎lapack-netlib/LAPACKE/include/lapack.h

Lines changed: 32 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -11517,6 +11517,22 @@ void LAPACK_sorgtsqr_row(
1151711517
float* work, lapack_int const* lwork,
1151811518
lapack_int* info );
1151911519

11520+
#define LAPACK_dorhr_col LAPACK_GLOBAL(dorhr_col,DORHR_COL)
11521+
void LAPACK_dorhr_col(
11522+
lapack_int const* m, lapack_int const* n,
11523+
lapack_int const* nb, double* A,
11524+
lapack_int const* lda, double* T,
11525+
lapack_int const* ldt, double* D,
11526+
lapack_int* info );
11527+
11528+
#define LAPACK_sorhr_col LAPACK_GLOBAL(sorhr_col,SORHR_COL)
11529+
void LAPACK_sorhr_col(
11530+
lapack_int const* m, lapack_int const* n,
11531+
lapack_int const* nb, float* A,
11532+
lapack_int const* lda, float* T,
11533+
lapack_int const* ldt, float* D,
11534+
lapack_int* info );
11535+
1152011536
#define LAPACK_dormbr_base LAPACK_GLOBAL(dormbr,DORMBR)
1152111537
void LAPACK_dormbr_base(
1152211538
char const* vect, char const* side, char const* trans,
@@ -22708,6 +22724,22 @@ void LAPACK_zungtsqr_row(
2270822724
lapack_complex_double* work, lapack_int const* lwork,
2270922725
lapack_int* info );
2271022726

22727+
#define LAPACK_cunhr_col LAPACK_GLOBAL(cunhr_col,CUNHR_COL)
22728+
void LAPACK_cunhr_col(
22729+
lapack_int const* m, lapack_int const* n,
22730+
lapack_int const* nb, lapack_complex_float* A,
22731+
lapack_int const* lda, lapack_complex_float* T,
22732+
lapack_int const* ldt, lapack_complex_float* D,
22733+
lapack_int* info );
22734+
22735+
#define LAPACK_zunhr_col LAPACK_GLOBAL(zunhr_col,ZUNHR_COL)
22736+
void LAPACK_zunhr_col(
22737+
lapack_int const* m, lapack_int const* n,
22738+
lapack_int const* nb, lapack_complex_double* A,
22739+
lapack_int const* lda, lapack_complex_double* T,
22740+
lapack_int const* ldt, lapack_complex_double* D,
22741+
lapack_int* info );
22742+
2271122743
#define LAPACK_cunmbr_base LAPACK_GLOBAL(cunmbr,CUNMBR)
2271222744
void LAPACK_cunmbr_base(
2271322745
char const* vect, char const* side, char const* trans,

‎lapack-netlib/LAPACKE/include/lapacke.h

Lines changed: 35 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -12727,7 +12727,41 @@ lapack_int LAPACKE_zhetrs_aa_2stage_work( int matrix_layout, char uplo, lapack_i
1272712727
lapack_int lda, lapack_complex_double* tb,
1272812728
lapack_int ltb, lapack_int* ipiv, lapack_int* ipiv2,
1272912729
lapack_complex_double* b, lapack_int ldb );
12730-
12730+
12731+
//LAPACK 3.10.0
12732+
lapack_int LAPACKE_sorhr_col( int matrix_layout, lapack_int m, lapack_int n,
12733+
lapack_int nb, float* a,
12734+
lapack_int lda, float* t,
12735+
lapack_int ldt, float* d );
12736+
lapack_int LAPACKE_sorhr_col_work( int matrix_layout, lapack_int m, lapack_int n,
12737+
lapack_int nb, float* a,
12738+
lapack_int lda, float* t,
12739+
lapack_int ldt, float* d );
12740+
lapack_int LAPACKE_dorhr_col( int matrix_layout, lapack_int m, lapack_int n,
12741+
lapack_int nb, double* a,
12742+
lapack_int lda, double* t,
12743+
lapack_int ldt, double* d );
12744+
lapack_int LAPACKE_dorhr_col_work( int matrix_layout, lapack_int m, lapack_int n,
12745+
lapack_int nb, double* a,
12746+
lapack_int lda, double* t,
12747+
lapack_int ldt, double* d );
12748+
lapack_int LAPACKE_cunhr_col( int matrix_layout, lapack_int m, lapack_int n,
12749+
lapack_int nb, lapack_complex_float* a,
12750+
lapack_int lda, lapack_complex_float* t,
12751+
lapack_int ldt, lapack_complex_float* d );
12752+
lapack_int LAPACKE_cunhr_col_work( int matrix_layout, lapack_int m, lapack_int n,
12753+
lapack_int nb, lapack_complex_float* a,
12754+
lapack_int lda, lapack_complex_float* t,
12755+
lapack_int ldt, lapack_complex_float* d );
12756+
lapack_int LAPACKE_zunhr_col( int matrix_layout, lapack_int m, lapack_int n,
12757+
lapack_int nb, lapack_complex_double* a,
12758+
lapack_int lda, lapack_complex_double* t,
12759+
lapack_int ldt, lapack_complex_double* d );
12760+
lapack_int LAPACKE_zunhr_col_work( int matrix_layout, lapack_int m, lapack_int n,
12761+
lapack_int nb, lapack_complex_double* a,
12762+
lapack_int lda, lapack_complex_double* t,
12763+
lapack_int ldt, lapack_complex_double* d );
12764+
1273112765
/* APIs for set/get nancheck flags */
1273212766
void LAPACKE_set_nancheck( int flag );
1273312767
int LAPACKE_get_nancheck( void );

‎lapack-netlib/LAPACKE/src/CMakeLists.txt

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -589,6 +589,8 @@ lapacke_cungtr.c
589589
lapacke_cungtr_work.c
590590
lapacke_cungtsqr_row.c
591591
lapacke_cungtsqr_row_work.c
592+
lapacke_cunhr_col.c
593+
lapacke_cunhr_col_work.c
592594
lapacke_cunmbr.c
593595
lapacke_cunmbr_work.c
594596
lapacke_cunmhr.c
@@ -857,6 +859,8 @@ lapacke_dorgtr.c
857859
lapacke_dorgtr_work.c
858860
lapacke_dorgtsqr_row.c
859861
lapacke_dorgtsqr_row_work.c
862+
lapacke_dorhr_col.c
863+
lapacke_dorhr_col_work.c
860864
lapacke_dormbr.c
861865
lapacke_dormbr_work.c
862866
lapacke_dormhr.c
@@ -1432,6 +1436,8 @@ lapacke_sorgtr.c
14321436
lapacke_sorgtr_work.c
14331437
lapacke_sorgtsqr_row.c
14341438
lapacke_sorgtsqr_row_work.c
1439+
lapacke_sorhr_col.c
1440+
lapacke_sorhr_col_work.c
14351441
lapacke_sormbr.c
14361442
lapacke_sormbr_work.c
14371443
lapacke_sormhr.c
@@ -2346,6 +2352,8 @@ lapacke_zungtr.c
23462352
lapacke_zungtr_work.c
23472353
lapacke_zungtsqr_row.c
23482354
lapacke_zungtsqr_row_work.c
2355+
lapacke_zunhr_col.c
2356+
lapacke_zunhr_col_work.c
23492357
lapacke_zunmbr.c
23502358
lapacke_zunmbr_work.c
23512359
lapacke_zunmhr.c

‎lapack-netlib/LAPACKE/src/Makefile

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -640,6 +640,8 @@ lapacke_cungtr.o \
640640
lapacke_cungtr_work.o \
641641
lapacke_cungtsqr_row.o \
642642
lapacke_cungtsqr_row_work.o \
643+
lapacke_cunhr_col.o \
644+
lapacke_cunhr_col_work.o \
643645
lapacke_cunmbr.o \
644646
lapacke_cunmbr_work.o \
645647
lapacke_cunmhr.o \
@@ -912,6 +914,8 @@ lapacke_dorgtr.o \
912914
lapacke_dorgtr_work.o \
913915
lapacke_dorgtsqr_row.o \
914916
lapacke_dorgtsqr_row_work.o \
917+
lapacke_dorhr_col.o \
918+
lapacke_dorhr_col_work.o \
915919
lapacke_dormbr.o \
916920
lapacke_dormbr_work.o \
917921
lapacke_dormhr.o \
@@ -1486,6 +1490,8 @@ lapacke_sorgtr.o \
14861490
lapacke_sorgtr_work.o \
14871491
lapacke_sorgtsqr_row.o \
14881492
lapacke_sorgtsqr_row_work.o \
1493+
lapacke_sorhr_col.o \
1494+
lapacke_sorhr_col_work.o \
14891495
lapacke_sormbr.o \
14901496
lapacke_sormbr_work.o \
14911497
lapacke_sormhr.o \
@@ -2404,6 +2410,8 @@ lapacke_zungtr.o \
24042410
lapacke_zungtr_work.o \
24052411
lapacke_zungtsqr_row.o \
24062412
lapacke_zungtsqr_row_work.o \
2413+
lapacke_zunhr_col.o \
2414+
lapacke_zunhr_col_work.o \
24072415
lapacke_zunmbr.o \
24082416
lapacke_zunmbr_work.o \
24092417
lapacke_zunmhr.o \

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

Lines changed: 24 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,24 @@
1+
#include "lapacke_utils.h"
2+
3+
lapack_int LAPACKE_cunhr_col( int matrix_layout, lapack_int m, lapack_int n,
4+
lapack_int nb, lapack_complex_float* a,
5+
lapack_int lda, lapack_complex_float* t,
6+
lapack_int ldt, lapack_complex_float* d)
7+
{
8+
lapack_int info = 0;
9+
if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
10+
LAPACKE_xerbla( "LAPACKE_cunhr_col", -1 );
11+
return -1;
12+
}
13+
#ifndef LAPACK_DISABLE_NAN_CHECK
14+
if( LAPACKE_get_nancheck() ) {
15+
/* Optionally check input matrices for NaNs */
16+
if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
17+
return -5;
18+
}
19+
}
20+
#endif
21+
/* Call middle-level interface */
22+
info = LAPACKE_cunhr_col_work( matrix_layout, m, n, nb, a, lda, t, ldt, d );
23+
return info;
24+
}

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

Lines changed: 69 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,69 @@
1+
#include "lapacke_utils.h"
2+
3+
lapack_int LAPACKE_cunhr_col_work( int matrix_layout, lapack_int m, lapack_int n,
4+
lapack_int nb, lapack_complex_float* a,
5+
lapack_int lda, lapack_complex_float* t,
6+
lapack_int ldt, lapack_complex_float* d )
7+
{
8+
lapack_int info = 0;
9+
if( matrix_layout == LAPACK_COL_MAJOR ) {
10+
/* Call LAPACK function and adjust info */
11+
LAPACK_cunhr_col( &m, &n, &nb, a, &lda, t, &ldt, d, &info );
12+
if( info < 0 ) {
13+
info = info - 1;
14+
}
15+
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
16+
lapack_int lda_t = MAX(1,m);
17+
lapack_int ldt_t = MAX(1,MIN(nb,n));
18+
lapack_complex_float* a_t = NULL;
19+
lapack_complex_float* t_t = NULL;
20+
/* Check leading dimension(s) */
21+
if( lda < n ) {
22+
info = -6;
23+
LAPACKE_xerbla( "LAPACKE_cunhr_col_work", info );
24+
return info;
25+
}
26+
if( ldt < n ) {
27+
info = -8;
28+
LAPACKE_xerbla( "LAPACKE_cunhr_col_work", info );
29+
return info;
30+
}
31+
/* Allocate memory for temporary array(s) */
32+
a_t = (lapack_complex_float*)
33+
LAPACKE_malloc( sizeof(lapack_complex_float) * lda_t * MAX(1,n) );
34+
if( a_t == NULL ) {
35+
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
36+
goto exit_level_0;
37+
}
38+
t_t = (lapack_complex_float*)
39+
LAPACKE_malloc( sizeof(lapack_complex_float) *
40+
ldt_t * MAX(1,n) );
41+
if( t_t == NULL ) {
42+
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
43+
goto exit_level_1;
44+
}
45+
/* Transpose input matrices */
46+
LAPACKE_cge_trans( matrix_layout, m, n, a, lda, a_t, lda_t );
47+
/* Call LAPACK function and adjust info */
48+
LAPACK_cunhr_col( &m, &n, &nb, a_t, &lda_t, t_t, &ldt_t, d, &info );
49+
if( info < 0 ) {
50+
info = info - 1;
51+
}
52+
/* Transpose output matrices */
53+
LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
54+
LAPACKE_cge_trans( LAPACK_COL_MAJOR, ldt, n, t_t, ldt_t, t,
55+
ldt );
56+
/* Release memory and exit */
57+
LAPACKE_free( t_t );
58+
exit_level_1:
59+
LAPACKE_free( a_t );
60+
exit_level_0:
61+
if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
62+
LAPACKE_xerbla( "LAPACKE_cunhr_col_work", info );
63+
}
64+
} else {
65+
info = -1;
66+
LAPACKE_xerbla( "LAPACKE_cunhr_col_work", info );
67+
}
68+
return info;
69+
}

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

Lines changed: 24 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,24 @@
1+
#include "lapacke_utils.h"
2+
3+
lapack_int LAPACKE_dorhr_col( int matrix_layout, lapack_int m, lapack_int n,
4+
lapack_int nb, double* a,
5+
lapack_int lda, double* t,
6+
lapack_int ldt, double* d)
7+
{
8+
lapack_int info = 0;
9+
if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
10+
LAPACKE_xerbla( "LAPACKE_dorhr_col", -1 );
11+
return -1;
12+
}
13+
#ifndef LAPACK_DISABLE_NAN_CHECK
14+
if( LAPACKE_get_nancheck() ) {
15+
/* Optionally check input matrices for NaNs */
16+
if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
17+
return -5;
18+
}
19+
}
20+
#endif
21+
/* Call middle-level interface */
22+
info = LAPACKE_dorhr_col_work( matrix_layout, m, n, nb, a, lda, t, ldt, d );
23+
return info;
24+
}

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

Lines changed: 69 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,69 @@
1+
#include "lapacke_utils.h"
2+
3+
lapack_int LAPACKE_dorhr_col_work( int matrix_layout, lapack_int m, lapack_int n,
4+
lapack_int nb, double* a,
5+
lapack_int lda, double* t,
6+
lapack_int ldt, double* d )
7+
{
8+
lapack_int info = 0;
9+
if( matrix_layout == LAPACK_COL_MAJOR ) {
10+
/* Call LAPACK function and adjust info */
11+
LAPACK_dorhr_col( &m, &n, &nb, a, &lda, t, &ldt, d, &info );
12+
if( info < 0 ) {
13+
info = info - 1;
14+
}
15+
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
16+
lapack_int lda_t = MAX(1,m);
17+
lapack_int ldt_t = MAX(1,MIN(nb,n));
18+
double* a_t = NULL;
19+
double* t_t = NULL;
20+
/* Check leading dimension(s) */
21+
if( lda < n ) {
22+
info = -6;
23+
LAPACKE_xerbla( "LAPACKE_dorhr_col_work", info );
24+
return info;
25+
}
26+
if( ldt < n ) {
27+
info = -8;
28+
LAPACKE_xerbla( "LAPACKE_dorhr_col_work", info );
29+
return info;
30+
}
31+
/* Allocate memory for temporary array(s) */
32+
a_t = (double*)
33+
LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
34+
if( a_t == NULL ) {
35+
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
36+
goto exit_level_0;
37+
}
38+
t_t = (double*)
39+
LAPACKE_malloc( sizeof(double) *
40+
ldt_t * MAX(1,n) );
41+
if( t_t == NULL ) {
42+
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
43+
goto exit_level_1;
44+
}
45+
/* Transpose input matrices */
46+
LAPACKE_dge_trans( matrix_layout, m, n, a, lda, a_t, lda_t );
47+
/* Call LAPACK function and adjust info */
48+
LAPACK_dorhr_col( &m, &n, &nb, a_t, &lda_t, t_t, &ldt_t, d, &info );
49+
if( info < 0 ) {
50+
info = info - 1;
51+
}
52+
/* Transpose output matrices */
53+
LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
54+
LAPACKE_dge_trans( LAPACK_COL_MAJOR, ldt, n, t_t, ldt_t, t,
55+
ldt );
56+
/* Release memory and exit */
57+
LAPACKE_free( t_t );
58+
exit_level_1:
59+
LAPACKE_free( a_t );
60+
exit_level_0:
61+
if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
62+
LAPACKE_xerbla( "LAPACKE_dorhr_col_work", info );
63+
}
64+
} else {
65+
info = -1;
66+
LAPACKE_xerbla( "LAPACKE_dorhr_col_work", info );
67+
}
68+
return info;
69+
}

0 commit comments

Comments
 (0)