Add LAPACKE interfaces for [CZ]UNHR_COL and [SD]ORHR_COL (Reference-LAPACK PR 827)tags/v0.3.24
| @@ -590,6 +590,8 @@ set(CSRC | |||
| lapacke_cungtr_work.c | |||
| lapacke_cungtsqr_row.c | |||
| lapacke_cungtsqr_row_work.c | |||
| lapacke_cunhr_col.c | |||
| lapacke_cunhr_col_work.c | |||
| lapacke_cunmbr.c | |||
| lapacke_cunmbr_work.c | |||
| lapacke_cunmhr.c | |||
| @@ -862,6 +864,8 @@ set(DSRC | |||
| lapacke_dorgtr_work.c | |||
| lapacke_dorgtsqr_row.c | |||
| lapacke_dorgtsqr_row_work.c | |||
| lapacke_dorhr_col.c | |||
| lapacke_dorhr_col_work.c | |||
| lapacke_dormbr.c | |||
| lapacke_dormbr_work.c | |||
| lapacke_dormhr.c | |||
| @@ -1435,6 +1439,8 @@ set(SSRC | |||
| lapacke_sorgtr_work.c | |||
| lapacke_sorgtsqr_row.c | |||
| lapacke_sorgtsqr_row_work.c | |||
| lapacke_sorhr_col.c | |||
| lapacke_sorhr_col_work.c | |||
| lapacke_sormbr.c | |||
| lapacke_sormbr_work.c | |||
| lapacke_sormhr.c | |||
| @@ -2351,6 +2357,8 @@ set(ZSRC | |||
| lapacke_zungtr_work.c | |||
| lapacke_zungtsqr_row.c | |||
| lapacke_zungtsqr_row_work.c | |||
| lapacke_zunhr_col.c | |||
| lapacke_zunhr_col_work.c | |||
| lapacke_zunmbr.c | |||
| lapacke_zunmbr_work.c | |||
| lapacke_zunmhr.c | |||
| @@ -11517,6 +11517,22 @@ void LAPACK_sorgtsqr_row( | |||
| float* work, lapack_int const* lwork, | |||
| 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) | |||
| void LAPACK_dormbr_base( | |||
| 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_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) | |||
| void LAPACK_cunmbr_base( | |||
| char const* vect, char const* side, char const* trans, | |||
| @@ -12727,7 +12727,41 @@ lapack_int LAPACKE_zhetrs_aa_2stage_work( int matrix_layout, char uplo, lapack_i | |||
| lapack_int lda, lapack_complex_double* tb, | |||
| lapack_int ltb, lapack_int* ipiv, lapack_int* ipiv2, | |||
| 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 */ | |||
| void LAPACKE_set_nancheck( int flag ); | |||
| int LAPACKE_get_nancheck( void ); | |||
| @@ -589,6 +589,8 @@ lapacke_cungtr.c | |||
| lapacke_cungtr_work.c | |||
| lapacke_cungtsqr_row.c | |||
| lapacke_cungtsqr_row_work.c | |||
| lapacke_cunhr_col.c | |||
| lapacke_cunhr_col_work.c | |||
| lapacke_cunmbr.c | |||
| lapacke_cunmbr_work.c | |||
| lapacke_cunmhr.c | |||
| @@ -857,6 +859,8 @@ lapacke_dorgtr.c | |||
| lapacke_dorgtr_work.c | |||
| lapacke_dorgtsqr_row.c | |||
| lapacke_dorgtsqr_row_work.c | |||
| lapacke_dorhr_col.c | |||
| lapacke_dorhr_col_work.c | |||
| lapacke_dormbr.c | |||
| lapacke_dormbr_work.c | |||
| lapacke_dormhr.c | |||
| @@ -1432,6 +1436,8 @@ lapacke_sorgtr.c | |||
| lapacke_sorgtr_work.c | |||
| lapacke_sorgtsqr_row.c | |||
| lapacke_sorgtsqr_row_work.c | |||
| lapacke_sorhr_col.c | |||
| lapacke_sorhr_col_work.c | |||
| lapacke_sormbr.c | |||
| lapacke_sormbr_work.c | |||
| lapacke_sormhr.c | |||
| @@ -2346,6 +2352,8 @@ lapacke_zungtr.c | |||
| lapacke_zungtr_work.c | |||
| lapacke_zungtsqr_row.c | |||
| lapacke_zungtsqr_row_work.c | |||
| lapacke_zunhr_col.c | |||
| lapacke_zunhr_col_work.c | |||
| lapacke_zunmbr.c | |||
| lapacke_zunmbr_work.c | |||
| lapacke_zunmhr.c | |||
| @@ -640,6 +640,8 @@ lapacke_cungtr.o \ | |||
| lapacke_cungtr_work.o \ | |||
| lapacke_cungtsqr_row.o \ | |||
| lapacke_cungtsqr_row_work.o \ | |||
| lapacke_cunhr_col.o \ | |||
| lapacke_cunhr_col_work.o \ | |||
| lapacke_cunmbr.o \ | |||
| lapacke_cunmbr_work.o \ | |||
| lapacke_cunmhr.o \ | |||
| @@ -912,6 +914,8 @@ lapacke_dorgtr.o \ | |||
| lapacke_dorgtr_work.o \ | |||
| lapacke_dorgtsqr_row.o \ | |||
| lapacke_dorgtsqr_row_work.o \ | |||
| lapacke_dorhr_col.o \ | |||
| lapacke_dorhr_col_work.o \ | |||
| lapacke_dormbr.o \ | |||
| lapacke_dormbr_work.o \ | |||
| lapacke_dormhr.o \ | |||
| @@ -1486,6 +1490,8 @@ lapacke_sorgtr.o \ | |||
| lapacke_sorgtr_work.o \ | |||
| lapacke_sorgtsqr_row.o \ | |||
| lapacke_sorgtsqr_row_work.o \ | |||
| lapacke_sorhr_col.o \ | |||
| lapacke_sorhr_col_work.o \ | |||
| lapacke_sormbr.o \ | |||
| lapacke_sormbr_work.o \ | |||
| lapacke_sormhr.o \ | |||
| @@ -2404,6 +2410,8 @@ lapacke_zungtr.o \ | |||
| lapacke_zungtr_work.o \ | |||
| lapacke_zungtsqr_row.o \ | |||
| lapacke_zungtsqr_row_work.o \ | |||
| lapacke_zunhr_col.o \ | |||
| lapacke_zunhr_col_work.o \ | |||
| lapacke_zunmbr.o \ | |||
| lapacke_zunmbr_work.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; | |||
| } | |||