Merge pull request #4047 from martin-frbg/lapack827
Add LAPACKE interfaces for [CZ]UNHR_COL and [SD]ORHR_COL (Reference-LAPACK PR 827)
This commit is contained in:
commit
88c205c958
|
@ -590,6 +590,8 @@ set(CSRC
|
||||||
lapacke_cungtr_work.c
|
lapacke_cungtr_work.c
|
||||||
lapacke_cungtsqr_row.c
|
lapacke_cungtsqr_row.c
|
||||||
lapacke_cungtsqr_row_work.c
|
lapacke_cungtsqr_row_work.c
|
||||||
|
lapacke_cunhr_col.c
|
||||||
|
lapacke_cunhr_col_work.c
|
||||||
lapacke_cunmbr.c
|
lapacke_cunmbr.c
|
||||||
lapacke_cunmbr_work.c
|
lapacke_cunmbr_work.c
|
||||||
lapacke_cunmhr.c
|
lapacke_cunmhr.c
|
||||||
|
@ -862,6 +864,8 @@ set(DSRC
|
||||||
lapacke_dorgtr_work.c
|
lapacke_dorgtr_work.c
|
||||||
lapacke_dorgtsqr_row.c
|
lapacke_dorgtsqr_row.c
|
||||||
lapacke_dorgtsqr_row_work.c
|
lapacke_dorgtsqr_row_work.c
|
||||||
|
lapacke_dorhr_col.c
|
||||||
|
lapacke_dorhr_col_work.c
|
||||||
lapacke_dormbr.c
|
lapacke_dormbr.c
|
||||||
lapacke_dormbr_work.c
|
lapacke_dormbr_work.c
|
||||||
lapacke_dormhr.c
|
lapacke_dormhr.c
|
||||||
|
@ -1435,6 +1439,8 @@ set(SSRC
|
||||||
lapacke_sorgtr_work.c
|
lapacke_sorgtr_work.c
|
||||||
lapacke_sorgtsqr_row.c
|
lapacke_sorgtsqr_row.c
|
||||||
lapacke_sorgtsqr_row_work.c
|
lapacke_sorgtsqr_row_work.c
|
||||||
|
lapacke_sorhr_col.c
|
||||||
|
lapacke_sorhr_col_work.c
|
||||||
lapacke_sormbr.c
|
lapacke_sormbr.c
|
||||||
lapacke_sormbr_work.c
|
lapacke_sormbr_work.c
|
||||||
lapacke_sormhr.c
|
lapacke_sormhr.c
|
||||||
|
@ -2351,6 +2357,8 @@ set(ZSRC
|
||||||
lapacke_zungtr_work.c
|
lapacke_zungtr_work.c
|
||||||
lapacke_zungtsqr_row.c
|
lapacke_zungtsqr_row.c
|
||||||
lapacke_zungtsqr_row_work.c
|
lapacke_zungtsqr_row_work.c
|
||||||
|
lapacke_zunhr_col.c
|
||||||
|
lapacke_zunhr_col_work.c
|
||||||
lapacke_zunmbr.c
|
lapacke_zunmbr.c
|
||||||
lapacke_zunmbr_work.c
|
lapacke_zunmbr_work.c
|
||||||
lapacke_zunmhr.c
|
lapacke_zunmhr.c
|
||||||
|
|
|
@ -11517,6 +11517,22 @@ void LAPACK_sorgtsqr_row(
|
||||||
float* work, lapack_int const* lwork,
|
float* work, lapack_int const* lwork,
|
||||||
lapack_int* info );
|
lapack_int* info );
|
||||||
|
|
||||||
|
#define LAPACK_dorhr_col LAPACK_GLOBAL(dorhr_col,DORHR_COL)
|
||||||
|
void LAPACK_dorhr_col(
|
||||||
|
lapack_int const* m, lapack_int const* n,
|
||||||
|
lapack_int const* nb, double* A,
|
||||||
|
lapack_int const* lda, double* T,
|
||||||
|
lapack_int const* ldt, double* D,
|
||||||
|
lapack_int* info );
|
||||||
|
|
||||||
|
#define LAPACK_sorhr_col LAPACK_GLOBAL(sorhr_col,SORHR_COL)
|
||||||
|
void LAPACK_sorhr_col(
|
||||||
|
lapack_int const* m, lapack_int const* n,
|
||||||
|
lapack_int const* nb, float* A,
|
||||||
|
lapack_int const* lda, float* T,
|
||||||
|
lapack_int const* ldt, float* D,
|
||||||
|
lapack_int* info );
|
||||||
|
|
||||||
#define LAPACK_dormbr_base LAPACK_GLOBAL(dormbr,DORMBR)
|
#define LAPACK_dormbr_base LAPACK_GLOBAL(dormbr,DORMBR)
|
||||||
void LAPACK_dormbr_base(
|
void LAPACK_dormbr_base(
|
||||||
char const* vect, char const* side, char const* trans,
|
char const* vect, char const* side, char const* trans,
|
||||||
|
@ -22708,6 +22724,22 @@ void LAPACK_zungtsqr_row(
|
||||||
lapack_complex_double* work, lapack_int const* lwork,
|
lapack_complex_double* work, lapack_int const* lwork,
|
||||||
lapack_int* info );
|
lapack_int* info );
|
||||||
|
|
||||||
|
#define LAPACK_cunhr_col LAPACK_GLOBAL(cunhr_col,CUNHR_COL)
|
||||||
|
void LAPACK_cunhr_col(
|
||||||
|
lapack_int const* m, lapack_int const* n,
|
||||||
|
lapack_int const* nb, lapack_complex_float* A,
|
||||||
|
lapack_int const* lda, lapack_complex_float* T,
|
||||||
|
lapack_int const* ldt, lapack_complex_float* D,
|
||||||
|
lapack_int* info );
|
||||||
|
|
||||||
|
#define LAPACK_zunhr_col LAPACK_GLOBAL(zunhr_col,ZUNHR_COL)
|
||||||
|
void LAPACK_zunhr_col(
|
||||||
|
lapack_int const* m, lapack_int const* n,
|
||||||
|
lapack_int const* nb, lapack_complex_double* A,
|
||||||
|
lapack_int const* lda, lapack_complex_double* T,
|
||||||
|
lapack_int const* ldt, lapack_complex_double* D,
|
||||||
|
lapack_int* info );
|
||||||
|
|
||||||
#define LAPACK_cunmbr_base LAPACK_GLOBAL(cunmbr,CUNMBR)
|
#define LAPACK_cunmbr_base LAPACK_GLOBAL(cunmbr,CUNMBR)
|
||||||
void LAPACK_cunmbr_base(
|
void LAPACK_cunmbr_base(
|
||||||
char const* vect, char const* side, char const* trans,
|
char const* vect, char const* side, char const* trans,
|
||||||
|
|
|
@ -12728,6 +12728,40 @@ lapack_int LAPACKE_zhetrs_aa_2stage_work( int matrix_layout, char uplo, lapack_i
|
||||||
lapack_int ltb, lapack_int* ipiv, lapack_int* ipiv2,
|
lapack_int ltb, lapack_int* ipiv, lapack_int* ipiv2,
|
||||||
lapack_complex_double* b, lapack_int ldb );
|
lapack_complex_double* b, lapack_int ldb );
|
||||||
|
|
||||||
|
//LAPACK 3.10.0
|
||||||
|
lapack_int LAPACKE_sorhr_col( int matrix_layout, lapack_int m, lapack_int n,
|
||||||
|
lapack_int nb, float* a,
|
||||||
|
lapack_int lda, float* t,
|
||||||
|
lapack_int ldt, float* d );
|
||||||
|
lapack_int LAPACKE_sorhr_col_work( int matrix_layout, lapack_int m, lapack_int n,
|
||||||
|
lapack_int nb, float* a,
|
||||||
|
lapack_int lda, float* t,
|
||||||
|
lapack_int ldt, float* d );
|
||||||
|
lapack_int LAPACKE_dorhr_col( int matrix_layout, lapack_int m, lapack_int n,
|
||||||
|
lapack_int nb, double* a,
|
||||||
|
lapack_int lda, double* t,
|
||||||
|
lapack_int ldt, double* d );
|
||||||
|
lapack_int LAPACKE_dorhr_col_work( int matrix_layout, lapack_int m, lapack_int n,
|
||||||
|
lapack_int nb, double* a,
|
||||||
|
lapack_int lda, double* t,
|
||||||
|
lapack_int ldt, double* d );
|
||||||
|
lapack_int LAPACKE_cunhr_col( int matrix_layout, lapack_int m, lapack_int n,
|
||||||
|
lapack_int nb, lapack_complex_float* a,
|
||||||
|
lapack_int lda, lapack_complex_float* t,
|
||||||
|
lapack_int ldt, lapack_complex_float* d );
|
||||||
|
lapack_int LAPACKE_cunhr_col_work( int matrix_layout, lapack_int m, lapack_int n,
|
||||||
|
lapack_int nb, lapack_complex_float* a,
|
||||||
|
lapack_int lda, lapack_complex_float* t,
|
||||||
|
lapack_int ldt, lapack_complex_float* d );
|
||||||
|
lapack_int LAPACKE_zunhr_col( int matrix_layout, lapack_int m, lapack_int n,
|
||||||
|
lapack_int nb, lapack_complex_double* a,
|
||||||
|
lapack_int lda, lapack_complex_double* t,
|
||||||
|
lapack_int ldt, lapack_complex_double* d );
|
||||||
|
lapack_int LAPACKE_zunhr_col_work( int matrix_layout, lapack_int m, lapack_int n,
|
||||||
|
lapack_int nb, lapack_complex_double* a,
|
||||||
|
lapack_int lda, lapack_complex_double* t,
|
||||||
|
lapack_int ldt, lapack_complex_double* d );
|
||||||
|
|
||||||
/* APIs for set/get nancheck flags */
|
/* APIs for set/get nancheck flags */
|
||||||
void LAPACKE_set_nancheck( int flag );
|
void LAPACKE_set_nancheck( int flag );
|
||||||
int LAPACKE_get_nancheck( void );
|
int LAPACKE_get_nancheck( void );
|
||||||
|
|
|
@ -589,6 +589,8 @@ lapacke_cungtr.c
|
||||||
lapacke_cungtr_work.c
|
lapacke_cungtr_work.c
|
||||||
lapacke_cungtsqr_row.c
|
lapacke_cungtsqr_row.c
|
||||||
lapacke_cungtsqr_row_work.c
|
lapacke_cungtsqr_row_work.c
|
||||||
|
lapacke_cunhr_col.c
|
||||||
|
lapacke_cunhr_col_work.c
|
||||||
lapacke_cunmbr.c
|
lapacke_cunmbr.c
|
||||||
lapacke_cunmbr_work.c
|
lapacke_cunmbr_work.c
|
||||||
lapacke_cunmhr.c
|
lapacke_cunmhr.c
|
||||||
|
@ -857,6 +859,8 @@ lapacke_dorgtr.c
|
||||||
lapacke_dorgtr_work.c
|
lapacke_dorgtr_work.c
|
||||||
lapacke_dorgtsqr_row.c
|
lapacke_dorgtsqr_row.c
|
||||||
lapacke_dorgtsqr_row_work.c
|
lapacke_dorgtsqr_row_work.c
|
||||||
|
lapacke_dorhr_col.c
|
||||||
|
lapacke_dorhr_col_work.c
|
||||||
lapacke_dormbr.c
|
lapacke_dormbr.c
|
||||||
lapacke_dormbr_work.c
|
lapacke_dormbr_work.c
|
||||||
lapacke_dormhr.c
|
lapacke_dormhr.c
|
||||||
|
@ -1432,6 +1436,8 @@ lapacke_sorgtr.c
|
||||||
lapacke_sorgtr_work.c
|
lapacke_sorgtr_work.c
|
||||||
lapacke_sorgtsqr_row.c
|
lapacke_sorgtsqr_row.c
|
||||||
lapacke_sorgtsqr_row_work.c
|
lapacke_sorgtsqr_row_work.c
|
||||||
|
lapacke_sorhr_col.c
|
||||||
|
lapacke_sorhr_col_work.c
|
||||||
lapacke_sormbr.c
|
lapacke_sormbr.c
|
||||||
lapacke_sormbr_work.c
|
lapacke_sormbr_work.c
|
||||||
lapacke_sormhr.c
|
lapacke_sormhr.c
|
||||||
|
@ -2346,6 +2352,8 @@ lapacke_zungtr.c
|
||||||
lapacke_zungtr_work.c
|
lapacke_zungtr_work.c
|
||||||
lapacke_zungtsqr_row.c
|
lapacke_zungtsqr_row.c
|
||||||
lapacke_zungtsqr_row_work.c
|
lapacke_zungtsqr_row_work.c
|
||||||
|
lapacke_zunhr_col.c
|
||||||
|
lapacke_zunhr_col_work.c
|
||||||
lapacke_zunmbr.c
|
lapacke_zunmbr.c
|
||||||
lapacke_zunmbr_work.c
|
lapacke_zunmbr_work.c
|
||||||
lapacke_zunmhr.c
|
lapacke_zunmhr.c
|
||||||
|
|
|
@ -640,6 +640,8 @@ lapacke_cungtr.o \
|
||||||
lapacke_cungtr_work.o \
|
lapacke_cungtr_work.o \
|
||||||
lapacke_cungtsqr_row.o \
|
lapacke_cungtsqr_row.o \
|
||||||
lapacke_cungtsqr_row_work.o \
|
lapacke_cungtsqr_row_work.o \
|
||||||
|
lapacke_cunhr_col.o \
|
||||||
|
lapacke_cunhr_col_work.o \
|
||||||
lapacke_cunmbr.o \
|
lapacke_cunmbr.o \
|
||||||
lapacke_cunmbr_work.o \
|
lapacke_cunmbr_work.o \
|
||||||
lapacke_cunmhr.o \
|
lapacke_cunmhr.o \
|
||||||
|
@ -912,6 +914,8 @@ lapacke_dorgtr.o \
|
||||||
lapacke_dorgtr_work.o \
|
lapacke_dorgtr_work.o \
|
||||||
lapacke_dorgtsqr_row.o \
|
lapacke_dorgtsqr_row.o \
|
||||||
lapacke_dorgtsqr_row_work.o \
|
lapacke_dorgtsqr_row_work.o \
|
||||||
|
lapacke_dorhr_col.o \
|
||||||
|
lapacke_dorhr_col_work.o \
|
||||||
lapacke_dormbr.o \
|
lapacke_dormbr.o \
|
||||||
lapacke_dormbr_work.o \
|
lapacke_dormbr_work.o \
|
||||||
lapacke_dormhr.o \
|
lapacke_dormhr.o \
|
||||||
|
@ -1486,6 +1490,8 @@ lapacke_sorgtr.o \
|
||||||
lapacke_sorgtr_work.o \
|
lapacke_sorgtr_work.o \
|
||||||
lapacke_sorgtsqr_row.o \
|
lapacke_sorgtsqr_row.o \
|
||||||
lapacke_sorgtsqr_row_work.o \
|
lapacke_sorgtsqr_row_work.o \
|
||||||
|
lapacke_sorhr_col.o \
|
||||||
|
lapacke_sorhr_col_work.o \
|
||||||
lapacke_sormbr.o \
|
lapacke_sormbr.o \
|
||||||
lapacke_sormbr_work.o \
|
lapacke_sormbr_work.o \
|
||||||
lapacke_sormhr.o \
|
lapacke_sormhr.o \
|
||||||
|
@ -2404,6 +2410,8 @@ lapacke_zungtr.o \
|
||||||
lapacke_zungtr_work.o \
|
lapacke_zungtr_work.o \
|
||||||
lapacke_zungtsqr_row.o \
|
lapacke_zungtsqr_row.o \
|
||||||
lapacke_zungtsqr_row_work.o \
|
lapacke_zungtsqr_row_work.o \
|
||||||
|
lapacke_zunhr_col.o \
|
||||||
|
lapacke_zunhr_col_work.o \
|
||||||
lapacke_zunmbr.o \
|
lapacke_zunmbr.o \
|
||||||
lapacke_zunmbr_work.o \
|
lapacke_zunmbr_work.o \
|
||||||
lapacke_zunmhr.o \
|
lapacke_zunmhr.o \
|
||||||
|
|
|
@ -0,0 +1,24 @@
|
||||||
|
#include "lapacke_utils.h"
|
||||||
|
|
||||||
|
lapack_int LAPACKE_cunhr_col( int matrix_layout, lapack_int m, lapack_int n,
|
||||||
|
lapack_int nb, lapack_complex_float* a,
|
||||||
|
lapack_int lda, lapack_complex_float* t,
|
||||||
|
lapack_int ldt, lapack_complex_float* d)
|
||||||
|
{
|
||||||
|
lapack_int info = 0;
|
||||||
|
if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
|
||||||
|
LAPACKE_xerbla( "LAPACKE_cunhr_col", -1 );
|
||||||
|
return -1;
|
||||||
|
}
|
||||||
|
#ifndef LAPACK_DISABLE_NAN_CHECK
|
||||||
|
if( LAPACKE_get_nancheck() ) {
|
||||||
|
/* Optionally check input matrices for NaNs */
|
||||||
|
if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) {
|
||||||
|
return -5;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#endif
|
||||||
|
/* Call middle-level interface */
|
||||||
|
info = LAPACKE_cunhr_col_work( matrix_layout, m, n, nb, a, lda, t, ldt, d );
|
||||||
|
return info;
|
||||||
|
}
|
|
@ -0,0 +1,69 @@
|
||||||
|
#include "lapacke_utils.h"
|
||||||
|
|
||||||
|
lapack_int LAPACKE_cunhr_col_work( int matrix_layout, lapack_int m, lapack_int n,
|
||||||
|
lapack_int nb, lapack_complex_float* a,
|
||||||
|
lapack_int lda, lapack_complex_float* t,
|
||||||
|
lapack_int ldt, lapack_complex_float* d )
|
||||||
|
{
|
||||||
|
lapack_int info = 0;
|
||||||
|
if( matrix_layout == LAPACK_COL_MAJOR ) {
|
||||||
|
/* Call LAPACK function and adjust info */
|
||||||
|
LAPACK_cunhr_col( &m, &n, &nb, a, &lda, t, &ldt, d, &info );
|
||||||
|
if( info < 0 ) {
|
||||||
|
info = info - 1;
|
||||||
|
}
|
||||||
|
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
|
||||||
|
lapack_int lda_t = MAX(1,m);
|
||||||
|
lapack_int ldt_t = MAX(1,MIN(nb,n));
|
||||||
|
lapack_complex_float* a_t = NULL;
|
||||||
|
lapack_complex_float* t_t = NULL;
|
||||||
|
/* Check leading dimension(s) */
|
||||||
|
if( lda < n ) {
|
||||||
|
info = -6;
|
||||||
|
LAPACKE_xerbla( "LAPACKE_cunhr_col_work", info );
|
||||||
|
return info;
|
||||||
|
}
|
||||||
|
if( ldt < n ) {
|
||||||
|
info = -8;
|
||||||
|
LAPACKE_xerbla( "LAPACKE_cunhr_col_work", info );
|
||||||
|
return info;
|
||||||
|
}
|
||||||
|
/* Allocate memory for temporary array(s) */
|
||||||
|
a_t = (lapack_complex_float*)
|
||||||
|
LAPACKE_malloc( sizeof(lapack_complex_float) * lda_t * MAX(1,n) );
|
||||||
|
if( a_t == NULL ) {
|
||||||
|
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
|
||||||
|
goto exit_level_0;
|
||||||
|
}
|
||||||
|
t_t = (lapack_complex_float*)
|
||||||
|
LAPACKE_malloc( sizeof(lapack_complex_float) *
|
||||||
|
ldt_t * MAX(1,n) );
|
||||||
|
if( t_t == NULL ) {
|
||||||
|
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
|
||||||
|
goto exit_level_1;
|
||||||
|
}
|
||||||
|
/* Transpose input matrices */
|
||||||
|
LAPACKE_cge_trans( matrix_layout, m, n, a, lda, a_t, lda_t );
|
||||||
|
/* Call LAPACK function and adjust info */
|
||||||
|
LAPACK_cunhr_col( &m, &n, &nb, a_t, &lda_t, t_t, &ldt_t, d, &info );
|
||||||
|
if( info < 0 ) {
|
||||||
|
info = info - 1;
|
||||||
|
}
|
||||||
|
/* Transpose output matrices */
|
||||||
|
LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
|
||||||
|
LAPACKE_cge_trans( LAPACK_COL_MAJOR, ldt, n, t_t, ldt_t, t,
|
||||||
|
ldt );
|
||||||
|
/* Release memory and exit */
|
||||||
|
LAPACKE_free( t_t );
|
||||||
|
exit_level_1:
|
||||||
|
LAPACKE_free( a_t );
|
||||||
|
exit_level_0:
|
||||||
|
if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
|
||||||
|
LAPACKE_xerbla( "LAPACKE_cunhr_col_work", info );
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
info = -1;
|
||||||
|
LAPACKE_xerbla( "LAPACKE_cunhr_col_work", info );
|
||||||
|
}
|
||||||
|
return info;
|
||||||
|
}
|
|
@ -0,0 +1,24 @@
|
||||||
|
#include "lapacke_utils.h"
|
||||||
|
|
||||||
|
lapack_int LAPACKE_dorhr_col( int matrix_layout, lapack_int m, lapack_int n,
|
||||||
|
lapack_int nb, double* a,
|
||||||
|
lapack_int lda, double* t,
|
||||||
|
lapack_int ldt, double* d)
|
||||||
|
{
|
||||||
|
lapack_int info = 0;
|
||||||
|
if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
|
||||||
|
LAPACKE_xerbla( "LAPACKE_dorhr_col", -1 );
|
||||||
|
return -1;
|
||||||
|
}
|
||||||
|
#ifndef LAPACK_DISABLE_NAN_CHECK
|
||||||
|
if( LAPACKE_get_nancheck() ) {
|
||||||
|
/* Optionally check input matrices for NaNs */
|
||||||
|
if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
|
||||||
|
return -5;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#endif
|
||||||
|
/* Call middle-level interface */
|
||||||
|
info = LAPACKE_dorhr_col_work( matrix_layout, m, n, nb, a, lda, t, ldt, d );
|
||||||
|
return info;
|
||||||
|
}
|
|
@ -0,0 +1,69 @@
|
||||||
|
#include "lapacke_utils.h"
|
||||||
|
|
||||||
|
lapack_int LAPACKE_dorhr_col_work( int matrix_layout, lapack_int m, lapack_int n,
|
||||||
|
lapack_int nb, double* a,
|
||||||
|
lapack_int lda, double* t,
|
||||||
|
lapack_int ldt, double* d )
|
||||||
|
{
|
||||||
|
lapack_int info = 0;
|
||||||
|
if( matrix_layout == LAPACK_COL_MAJOR ) {
|
||||||
|
/* Call LAPACK function and adjust info */
|
||||||
|
LAPACK_dorhr_col( &m, &n, &nb, a, &lda, t, &ldt, d, &info );
|
||||||
|
if( info < 0 ) {
|
||||||
|
info = info - 1;
|
||||||
|
}
|
||||||
|
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
|
||||||
|
lapack_int lda_t = MAX(1,m);
|
||||||
|
lapack_int ldt_t = MAX(1,MIN(nb,n));
|
||||||
|
double* a_t = NULL;
|
||||||
|
double* t_t = NULL;
|
||||||
|
/* Check leading dimension(s) */
|
||||||
|
if( lda < n ) {
|
||||||
|
info = -6;
|
||||||
|
LAPACKE_xerbla( "LAPACKE_dorhr_col_work", info );
|
||||||
|
return info;
|
||||||
|
}
|
||||||
|
if( ldt < n ) {
|
||||||
|
info = -8;
|
||||||
|
LAPACKE_xerbla( "LAPACKE_dorhr_col_work", info );
|
||||||
|
return info;
|
||||||
|
}
|
||||||
|
/* Allocate memory for temporary array(s) */
|
||||||
|
a_t = (double*)
|
||||||
|
LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
|
||||||
|
if( a_t == NULL ) {
|
||||||
|
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
|
||||||
|
goto exit_level_0;
|
||||||
|
}
|
||||||
|
t_t = (double*)
|
||||||
|
LAPACKE_malloc( sizeof(double) *
|
||||||
|
ldt_t * MAX(1,n) );
|
||||||
|
if( t_t == NULL ) {
|
||||||
|
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
|
||||||
|
goto exit_level_1;
|
||||||
|
}
|
||||||
|
/* Transpose input matrices */
|
||||||
|
LAPACKE_dge_trans( matrix_layout, m, n, a, lda, a_t, lda_t );
|
||||||
|
/* Call LAPACK function and adjust info */
|
||||||
|
LAPACK_dorhr_col( &m, &n, &nb, a_t, &lda_t, t_t, &ldt_t, d, &info );
|
||||||
|
if( info < 0 ) {
|
||||||
|
info = info - 1;
|
||||||
|
}
|
||||||
|
/* Transpose output matrices */
|
||||||
|
LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
|
||||||
|
LAPACKE_dge_trans( LAPACK_COL_MAJOR, ldt, n, t_t, ldt_t, t,
|
||||||
|
ldt );
|
||||||
|
/* Release memory and exit */
|
||||||
|
LAPACKE_free( t_t );
|
||||||
|
exit_level_1:
|
||||||
|
LAPACKE_free( a_t );
|
||||||
|
exit_level_0:
|
||||||
|
if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
|
||||||
|
LAPACKE_xerbla( "LAPACKE_dorhr_col_work", info );
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
info = -1;
|
||||||
|
LAPACKE_xerbla( "LAPACKE_dorhr_col_work", info );
|
||||||
|
}
|
||||||
|
return info;
|
||||||
|
}
|
|
@ -0,0 +1,24 @@
|
||||||
|
#include "lapacke_utils.h"
|
||||||
|
|
||||||
|
lapack_int LAPACKE_sorhr_col( int matrix_layout, lapack_int m, lapack_int n,
|
||||||
|
lapack_int nb, float* a,
|
||||||
|
lapack_int lda, float* t,
|
||||||
|
lapack_int ldt, float* d)
|
||||||
|
{
|
||||||
|
lapack_int info = 0;
|
||||||
|
if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
|
||||||
|
LAPACKE_xerbla( "LAPACKE_sorhr_col", -1 );
|
||||||
|
return -1;
|
||||||
|
}
|
||||||
|
#ifndef LAPACK_DISABLE_NAN_CHECK
|
||||||
|
if( LAPACKE_get_nancheck() ) {
|
||||||
|
/* Optionally check input matrices for NaNs */
|
||||||
|
if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) {
|
||||||
|
return -5;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#endif
|
||||||
|
/* Call middle-level interface */
|
||||||
|
info = LAPACKE_sorhr_col_work( matrix_layout, m, n, nb, a, lda, t, ldt, d );
|
||||||
|
return info;
|
||||||
|
}
|
|
@ -0,0 +1,69 @@
|
||||||
|
#include "lapacke_utils.h"
|
||||||
|
|
||||||
|
lapack_int LAPACKE_sorhr_col_work( int matrix_layout, lapack_int m, lapack_int n,
|
||||||
|
lapack_int nb, float* a,
|
||||||
|
lapack_int lda, float* t,
|
||||||
|
lapack_int ldt, float* d )
|
||||||
|
{
|
||||||
|
lapack_int info = 0;
|
||||||
|
if( matrix_layout == LAPACK_COL_MAJOR ) {
|
||||||
|
/* Call LAPACK function and adjust info */
|
||||||
|
LAPACK_sorhr_col( &m, &n, &nb, a, &lda, t, &ldt, d, &info );
|
||||||
|
if( info < 0 ) {
|
||||||
|
info = info - 1;
|
||||||
|
}
|
||||||
|
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
|
||||||
|
lapack_int lda_t = MAX(1,m);
|
||||||
|
lapack_int ldt_t = MAX(1,MIN(nb,n));
|
||||||
|
float* a_t = NULL;
|
||||||
|
float* t_t = NULL;
|
||||||
|
/* Check leading dimension(s) */
|
||||||
|
if( lda < n ) {
|
||||||
|
info = -6;
|
||||||
|
LAPACKE_xerbla( "LAPACKE_sorhr_col_work", info );
|
||||||
|
return info;
|
||||||
|
}
|
||||||
|
if( ldt < n ) {
|
||||||
|
info = -8;
|
||||||
|
LAPACKE_xerbla( "LAPACKE_sorhr_col_work", info );
|
||||||
|
return info;
|
||||||
|
}
|
||||||
|
/* Allocate memory for temporary array(s) */
|
||||||
|
a_t = (float*)
|
||||||
|
LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
|
||||||
|
if( a_t == NULL ) {
|
||||||
|
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
|
||||||
|
goto exit_level_0;
|
||||||
|
}
|
||||||
|
t_t = (float*)
|
||||||
|
LAPACKE_malloc( sizeof(float) *
|
||||||
|
ldt_t * MAX(1,n) );
|
||||||
|
if( t_t == NULL ) {
|
||||||
|
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
|
||||||
|
goto exit_level_1;
|
||||||
|
}
|
||||||
|
/* Transpose input matrices */
|
||||||
|
LAPACKE_sge_trans( matrix_layout, m, n, a, lda, a_t, lda_t );
|
||||||
|
/* Call LAPACK function and adjust info */
|
||||||
|
LAPACK_sorhr_col( &m, &n, &nb, a_t, &lda_t, t_t, &ldt_t, d, &info );
|
||||||
|
if( info < 0 ) {
|
||||||
|
info = info - 1;
|
||||||
|
}
|
||||||
|
/* Transpose output matrices */
|
||||||
|
LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
|
||||||
|
LAPACKE_sge_trans( LAPACK_COL_MAJOR, ldt, n, t_t, ldt_t, t,
|
||||||
|
ldt );
|
||||||
|
/* Release memory and exit */
|
||||||
|
LAPACKE_free( t_t );
|
||||||
|
exit_level_1:
|
||||||
|
LAPACKE_free( a_t );
|
||||||
|
exit_level_0:
|
||||||
|
if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
|
||||||
|
LAPACKE_xerbla( "LAPACKE_sorhr_col_work", info );
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
info = -1;
|
||||||
|
LAPACKE_xerbla( "LAPACKE_sorhr_col_work", info );
|
||||||
|
}
|
||||||
|
return info;
|
||||||
|
}
|
|
@ -0,0 +1,24 @@
|
||||||
|
#include "lapacke_utils.h"
|
||||||
|
|
||||||
|
lapack_int LAPACKE_zunhr_col( int matrix_layout, lapack_int m, lapack_int n,
|
||||||
|
lapack_int nb, lapack_complex_double* a,
|
||||||
|
lapack_int lda, lapack_complex_double* t,
|
||||||
|
lapack_int ldt, lapack_complex_double* d)
|
||||||
|
{
|
||||||
|
lapack_int info = 0;
|
||||||
|
if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
|
||||||
|
LAPACKE_xerbla( "LAPACKE_zunhr_col", -1 );
|
||||||
|
return -1;
|
||||||
|
}
|
||||||
|
#ifndef LAPACK_DISABLE_NAN_CHECK
|
||||||
|
if( LAPACKE_get_nancheck() ) {
|
||||||
|
/* Optionally check input matrices for NaNs */
|
||||||
|
if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) {
|
||||||
|
return -5;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#endif
|
||||||
|
/* Call middle-level interface */
|
||||||
|
info = LAPACKE_zunhr_col_work( matrix_layout, m, n, nb, a, lda, t, ldt, d );
|
||||||
|
return info;
|
||||||
|
}
|
|
@ -0,0 +1,69 @@
|
||||||
|
#include "lapacke_utils.h"
|
||||||
|
|
||||||
|
lapack_int LAPACKE_zunhr_col_work( int matrix_layout, lapack_int m, lapack_int n,
|
||||||
|
lapack_int nb, lapack_complex_double* a,
|
||||||
|
lapack_int lda, lapack_complex_double* t,
|
||||||
|
lapack_int ldt, lapack_complex_double* d )
|
||||||
|
{
|
||||||
|
lapack_int info = 0;
|
||||||
|
if( matrix_layout == LAPACK_COL_MAJOR ) {
|
||||||
|
/* Call LAPACK function and adjust info */
|
||||||
|
LAPACK_zunhr_col( &m, &n, &nb, a, &lda, t, &ldt, d, &info );
|
||||||
|
if( info < 0 ) {
|
||||||
|
info = info - 1;
|
||||||
|
}
|
||||||
|
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
|
||||||
|
lapack_int lda_t = MAX(1,m);
|
||||||
|
lapack_int ldt_t = MAX(1,MIN(nb,n));
|
||||||
|
lapack_complex_double* a_t = NULL;
|
||||||
|
lapack_complex_double* t_t = NULL;
|
||||||
|
/* Check leading dimension(s) */
|
||||||
|
if( lda < n ) {
|
||||||
|
info = -6;
|
||||||
|
LAPACKE_xerbla( "LAPACKE_zunhr_col_work", info );
|
||||||
|
return info;
|
||||||
|
}
|
||||||
|
if( ldt < n ) {
|
||||||
|
info = -8;
|
||||||
|
LAPACKE_xerbla( "LAPACKE_zunhr_col_work", info );
|
||||||
|
return info;
|
||||||
|
}
|
||||||
|
/* Allocate memory for temporary array(s) */
|
||||||
|
a_t = (lapack_complex_double*)
|
||||||
|
LAPACKE_malloc( sizeof(lapack_complex_double) * lda_t * MAX(1,n) );
|
||||||
|
if( a_t == NULL ) {
|
||||||
|
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
|
||||||
|
goto exit_level_0;
|
||||||
|
}
|
||||||
|
t_t = (lapack_complex_double*)
|
||||||
|
LAPACKE_malloc( sizeof(lapack_complex_double) *
|
||||||
|
ldt_t * MAX(1,n) );
|
||||||
|
if( t_t == NULL ) {
|
||||||
|
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
|
||||||
|
goto exit_level_1;
|
||||||
|
}
|
||||||
|
/* Transpose input matrices */
|
||||||
|
LAPACKE_zge_trans( matrix_layout, m, n, a, lda, a_t, lda_t );
|
||||||
|
/* Call LAPACK function and adjust info */
|
||||||
|
LAPACK_zunhr_col( &m, &n, &nb, a_t, &lda_t, t_t, &ldt_t, d, &info );
|
||||||
|
if( info < 0 ) {
|
||||||
|
info = info - 1;
|
||||||
|
}
|
||||||
|
/* Transpose output matrices */
|
||||||
|
LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda );
|
||||||
|
LAPACKE_zge_trans( LAPACK_COL_MAJOR, ldt, n, t_t, ldt_t, t,
|
||||||
|
ldt );
|
||||||
|
/* Release memory and exit */
|
||||||
|
LAPACKE_free( t_t );
|
||||||
|
exit_level_1:
|
||||||
|
LAPACKE_free( a_t );
|
||||||
|
exit_level_0:
|
||||||
|
if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
|
||||||
|
LAPACKE_xerbla( "LAPACKE_zunhr_col_work", info );
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
info = -1;
|
||||||
|
LAPACKE_xerbla( "LAPACKE_zunhr_col_work", info );
|
||||||
|
}
|
||||||
|
return info;
|
||||||
|
}
|
Loading…
Reference in New Issue