diff options
130 files changed, 10815 insertions, 702 deletions
@@ -18,3 +18,7 @@ TESTING/*.txt # LAPACKE example LAPACKE/example/xexample* + +# SED +SRC/*-e +LAPACKE/src/*-e diff --git a/LAPACKE/include/lapacke.h b/LAPACKE/include/lapacke.h index d7d19172..d43c6c6b 100644 --- a/LAPACKE/include/lapacke.h +++ b/LAPACKE/include/lapacke.h @@ -11569,6 +11569,438 @@ lapack_int LAPACKE_zhetrs_aa_work( int matrix_layout, char uplo, lapack_int n, lapack_complex_double* work, lapack_int lwork); +lapack_int LAPACKE_ssysv_rk( int matrix_layout, char uplo, lapack_int n, + lapack_int nrhs, float* a, lapack_int lda, + float* e, lapack_int* ipiv, float* b, lapack_int ldb ); +lapack_int LAPACKE_ssysv_rk_work( int matrix_layout, char uplo, lapack_int n, + lapack_int nrhs, float* a, lapack_int lda, + float* e, lapack_int* ipiv, float* b, lapack_int ldb, + float* work, lapack_int lwork ); +lapack_int LAPACKE_dsysv_rk( int matrix_layout, char uplo, lapack_int n, + lapack_int nrhs, double* a, lapack_int lda, + double* e, lapack_int* ipiv, double* b, lapack_int ldb ); +lapack_int LAPACKE_dsysv_rk_work( int matrix_layout, char uplo, lapack_int n, + lapack_int nrhs, double* a, lapack_int lda, + double* e, lapack_int* ipiv, double* b, lapack_int ldb, + double* work, lapack_int lwork ); +lapack_int LAPACKE_csysv_rk( int matrix_layout, char uplo, lapack_int n, + lapack_int nrhs, lapack_complex_float* a, + lapack_int lda, lapack_complex_float* e, lapack_int* ipiv, + lapack_complex_float* b, lapack_int ldb ); +lapack_int LAPACKE_csysv_rk_work( int matrix_layout, char uplo, lapack_int n, + lapack_int nrhs, lapack_complex_float* a, + lapack_int lda, lapack_complex_float* e, lapack_int* ipiv, + lapack_complex_float* b, lapack_int ldb, + lapack_complex_float* work, lapack_int lwork ); +lapack_int LAPACKE_zsysv_rk( int matrix_layout, char uplo, lapack_int n, + lapack_int nrhs, lapack_complex_double* a, + lapack_int lda, lapack_complex_double* e, lapack_int* ipiv, + lapack_complex_double* b, lapack_int ldb ); +lapack_int LAPACKE_zsysv_rk_work( int matrix_layout, char uplo, lapack_int n, + lapack_int nrhs, lapack_complex_double* a, + lapack_int lda, lapack_complex_double* e, lapack_int* ipiv, + lapack_complex_double* b, lapack_int ldb, + lapack_complex_double* work, lapack_int lwork ); +lapack_int LAPACKE_chesv_rk( int matrix_layout, char uplo, lapack_int n, + lapack_int nrhs, lapack_complex_float* a, + lapack_int lda, lapack_complex_float* e, lapack_int* ipiv, + lapack_complex_float* b, lapack_int ldb ); +lapack_int LAPACKE_chesv_rk_work( int matrix_layout, char uplo, lapack_int n, + lapack_int nrhs, lapack_complex_float* a, + lapack_int lda, lapack_complex_float* e, lapack_int* ipiv, + lapack_complex_float* b, lapack_int ldb, + lapack_complex_float* work, lapack_int lwork ); +lapack_int LAPACKE_zhesv_rk( int matrix_layout, char uplo, lapack_int n, + lapack_int nrhs, lapack_complex_double* a, + lapack_int lda, lapack_complex_double* e, lapack_int* ipiv, + lapack_complex_double* b, lapack_int ldb ); +lapack_int LAPACKE_zhesv_rk_work( int matrix_layout, char uplo, lapack_int n, + lapack_int nrhs, lapack_complex_double* a, + lapack_int lda, lapack_complex_double* e, lapack_int* ipiv, + lapack_complex_double* b, lapack_int ldb, + lapack_complex_double* work, lapack_int lwork ); + +lapack_int LAPACKE_ssytrf_rk( int matrix_layout, char uplo, lapack_int n, float* a, + lapack_int lda, float* e, lapack_int* ipiv ); +lapack_int LAPACKE_dsytrf_rk( int matrix_layout, char uplo, lapack_int n, double* a, + lapack_int lda, double* e, lapack_int* ipiv ); +lapack_int LAPACKE_csytrf_rk( int matrix_layout, char uplo, lapack_int n, + lapack_complex_float* a, lapack_int lda, + lapack_complex_float* e, lapack_int* ipiv ); +lapack_int LAPACKE_zsytrf_rk( int matrix_layout, char uplo, lapack_int n, + lapack_complex_double* a, lapack_int lda, + lapack_complex_double* e, lapack_int* ipiv ); +lapack_int LAPACKE_chetrf_rk( int matrix_layout, char uplo, lapack_int n, + lapack_complex_float* a, lapack_int lda, + lapack_complex_float* e, lapack_int* ipiv ); +lapack_int LAPACKE_zhetrf_rk( int matrix_layout, char uplo, lapack_int n, + lapack_complex_double* a, lapack_int lda, + lapack_complex_double* e, lapack_int* ipiv ); +lapack_int LAPACKE_ssytrf_rk_work( int matrix_layout, char uplo, lapack_int n, + float* a, lapack_int lda, float* e, lapack_int* ipiv, + float* work, lapack_int lwork ); +lapack_int LAPACKE_dsytrf_rk_work( int matrix_layout, char uplo, lapack_int n, + double* a, lapack_int lda, double* e, lapack_int* ipiv, + double* work, lapack_int lwork ); +lapack_int LAPACKE_csytrf_rk_work( int matrix_layout, char uplo, lapack_int n, + lapack_complex_float* a, lapack_int lda, + lapack_complex_float* e, + lapack_int* ipiv, lapack_complex_float* work, + lapack_int lwork ); +lapack_int LAPACKE_zsytrf_rk_work( int matrix_layout, char uplo, lapack_int n, + lapack_complex_double* a, lapack_int lda, + lapack_complex_double* e, + lapack_int* ipiv, lapack_complex_double* work, + lapack_int lwork ); +lapack_int LAPACKE_chetrf_rk_work( int matrix_layout, char uplo, lapack_int n, + lapack_complex_float* a, lapack_int lda, + lapack_complex_float* e, + lapack_int* ipiv, lapack_complex_float* work, + lapack_int lwork ); +lapack_int LAPACKE_zhetrf_rk_work( int matrix_layout, char uplo, lapack_int n, + lapack_complex_double* a, lapack_int lda, + lapack_complex_double* e, + lapack_int* ipiv, lapack_complex_double* work, + lapack_int lwork ); + +lapack_int LAPACKE_csytrs_3( int matrix_layout, char uplo, lapack_int n, + lapack_int nrhs, const lapack_complex_float* a, + lapack_int lda, const lapack_complex_float* e, + const lapack_int* ipiv, + lapack_complex_float* b, lapack_int ldb ); +lapack_int LAPACKE_csytrs_3_work( int matrix_layout, char uplo, lapack_int n, + lapack_int nrhs, const lapack_complex_float* a, + lapack_int lda, const lapack_complex_float* e, + const lapack_int* ipiv, + lapack_complex_float* b, lapack_int ldb); +lapack_int LAPACKE_chetrs_3( int matrix_layout, char uplo, lapack_int n, + lapack_int nrhs, const lapack_complex_float* a, + lapack_int lda, const lapack_complex_float* e, + const lapack_int* ipiv, + lapack_complex_float* b, lapack_int ldb ); +lapack_int LAPACKE_chetrs_3_work( int matrix_layout, char uplo, lapack_int n, + lapack_int nrhs, const lapack_complex_float* a, + lapack_int lda, const lapack_complex_float* e, + const lapack_int* ipiv, + lapack_complex_float* b, lapack_int ldb); +lapack_int LAPACKE_dsytrs_3( int matrix_layout, char uplo, lapack_int n, + lapack_int nrhs, const double* a, lapack_int lda, + const double* e, + const lapack_int* ipiv, double* b, lapack_int ldb ); +lapack_int LAPACKE_dsytrs_3_work( int matrix_layout, char uplo, lapack_int n, + lapack_int nrhs, const double* a, + lapack_int lda, const double* e, + const lapack_int* ipiv, + double* b, lapack_int ldb); +lapack_int LAPACKE_ssytrs_3( int matrix_layout, char uplo, lapack_int n, + lapack_int nrhs, const float* a, lapack_int lda, + const float* e, + const lapack_int* ipiv, float* b, lapack_int ldb ); +lapack_int LAPACKE_ssytrs_3_work( int matrix_layout, char uplo, lapack_int n, + lapack_int nrhs, const float* a, lapack_int lda, + const float* e, const lapack_int* ipiv, float* b, + lapack_int ldb); +lapack_int LAPACKE_zsytrs_3( int matrix_layout, char uplo, lapack_int n, + lapack_int nrhs, const lapack_complex_double* a, + lapack_int lda, const lapack_complex_double* e, + const lapack_int* ipiv, + lapack_complex_double* b, lapack_int ldb ); +lapack_int LAPACKE_zsytrs_3_work( int matrix_layout, char uplo, lapack_int n, + lapack_int nrhs, const lapack_complex_double* a, + lapack_int lda, const lapack_complex_double* e, + const lapack_int* ipiv, + lapack_complex_double* b, lapack_int ldb); +lapack_int LAPACKE_zhetrs_3( int matrix_layout, char uplo, lapack_int n, + lapack_int nrhs, const lapack_complex_double* a, + lapack_int lda, const lapack_complex_double* e, + const lapack_int* ipiv, + lapack_complex_double* b, lapack_int ldb ); +lapack_int LAPACKE_zhetrs_3_work( int matrix_layout, char uplo, lapack_int n, + lapack_int nrhs, const lapack_complex_double* a, + lapack_int lda, const lapack_complex_double* e, + const lapack_int* ipiv, + lapack_complex_double* b, lapack_int ldb); + +lapack_int LAPACKE_ssytri_3( int matrix_layout, char uplo, lapack_int n, float* a, + lapack_int lda, const float* e, const lapack_int* ipiv ); +lapack_int LAPACKE_dsytri_3( int matrix_layout, char uplo, lapack_int n, double* a, + lapack_int lda, const double* e, const lapack_int* ipiv ); +lapack_int LAPACKE_csytri_3( int matrix_layout, char uplo, lapack_int n, + lapack_complex_float* a, lapack_int lda, + const lapack_complex_float* e, const lapack_int* ipiv ); +lapack_int LAPACKE_zsytri_3( int matrix_layout, char uplo, lapack_int n, + lapack_complex_double* a, lapack_int lda, + const lapack_complex_double* e, const lapack_int* ipiv ); +lapack_int LAPACKE_chetri_3( int matrix_layout, char uplo, lapack_int n, + lapack_complex_float* a, lapack_int lda, + const lapack_complex_float* e, const lapack_int* ipiv ); +lapack_int LAPACKE_zhetri_3( int matrix_layout, char uplo, lapack_int n, + lapack_complex_double* a, lapack_int lda, + const lapack_complex_double* e, const lapack_int* ipiv ); +lapack_int LAPACKE_ssytri_3_work( int matrix_layout, char uplo, lapack_int n, float* a, + lapack_int lda, const float* e, const lapack_int* ipiv, + float* work, lapack_int lwork ); +lapack_int LAPACKE_dsytri_3_work( int matrix_layout, char uplo, lapack_int n, double* a, + lapack_int lda, const double* e, const lapack_int* ipiv, + double* work, lapack_int lwork ); +lapack_int LAPACKE_csytri_3_work( int matrix_layout, char uplo, lapack_int n, + lapack_complex_float* a, lapack_int lda, + const lapack_complex_float* e, const lapack_int* ipiv, + lapack_complex_float* work, lapack_int lwork ); +lapack_int LAPACKE_zsytri_3_work( int matrix_layout, char uplo, lapack_int n, + lapack_complex_double* a, lapack_int lda, + const lapack_complex_double* e, const lapack_int* ipiv, + lapack_complex_double* work, lapack_int lwork ); +lapack_int LAPACKE_chetri_3_work( int matrix_layout, char uplo, lapack_int n, + lapack_complex_float* a, lapack_int lda, + const lapack_complex_float* e, const lapack_int* ipiv, + lapack_complex_float* work, lapack_int lwork ); +lapack_int LAPACKE_zhetri_3_work( int matrix_layout, char uplo, lapack_int n, + lapack_complex_double* a, lapack_int lda, + const lapack_complex_double* e, const lapack_int* ipiv, + lapack_complex_double* work, lapack_int lwork ); + +lapack_int LAPACKE_ssycon_3( int matrix_layout, char uplo, lapack_int n, + const float* a, lapack_int lda, const float* e, + const lapack_int* ipiv, float anorm, float* rcond ); +lapack_int LAPACKE_dsycon_3( int matrix_layout, char uplo, lapack_int n, + const double* a, lapack_int lda, const double* e, + const lapack_int* ipiv, double anorm, + double* rcond ); +lapack_int LAPACKE_csycon_3( int matrix_layout, char uplo, lapack_int n, + const lapack_complex_float* a, lapack_int lda, + const lapack_complex_float* e, + const lapack_int* ipiv, float anorm, float* rcond ); +lapack_int LAPACKE_zsycon_3( int matrix_layout, char uplo, lapack_int n, + const lapack_complex_double* a, lapack_int lda, + const lapack_complex_double* e, + const lapack_int* ipiv, double anorm, + double* rcond ); +lapack_int LAPACKE_checon_3( int matrix_layout, char uplo, lapack_int n, + const lapack_complex_float* a, lapack_int lda, + const lapack_complex_float* e, + const lapack_int* ipiv, float anorm, float* rcond ); +lapack_int LAPACKE_zhecon_3( int matrix_layout, char uplo, lapack_int n, + const lapack_complex_double* a, lapack_int lda, + const lapack_complex_double* e, + const lapack_int* ipiv, double anorm, + double* rcond ); +lapack_int LAPACKE_ssycon_3_work( int matrix_layout, char uplo, lapack_int n, + const float* a, lapack_int lda, const float* e, + const lapack_int* ipiv, float anorm, + float* rcond, float* work, lapack_int* iwork ); +lapack_int LAPACKE_dsycon_3_work( int matrix_layout, char uplo, lapack_int n, + const double* a, lapack_int lda, const double* e, + const lapack_int* ipiv, double anorm, + double* rcond, double* work, + lapack_int* iwork ); +lapack_int LAPACKE_csycon_3_work( int matrix_layout, char uplo, lapack_int n, + const lapack_complex_float* a, lapack_int lda, + const lapack_complex_float* e, + const lapack_int* ipiv, float anorm, + float* rcond, lapack_complex_float* work ); +lapack_int LAPACKE_zsycon_3_work( int matrix_layout, char uplo, lapack_int n, + const lapack_complex_double* a, lapack_int lda, + const lapack_complex_double* e, + const lapack_int* ipiv, double anorm, + double* rcond, lapack_complex_double* work ); +lapack_int LAPACKE_checon_3_work( int matrix_layout, char uplo, lapack_int n, + const lapack_complex_float* a, lapack_int lda, + const lapack_complex_float* e, + const lapack_int* ipiv, float anorm, + float* rcond, lapack_complex_float* work ); +lapack_int LAPACKE_zhecon_3_work( int matrix_layout, char uplo, lapack_int n, + const lapack_complex_double* a, lapack_int lda, + const lapack_complex_double* e, + const lapack_int* ipiv, double anorm, + double* rcond, lapack_complex_double* work ); + +lapack_int LAPACKE_sgelq( int matrix_layout, lapack_int m, lapack_int n, + float* a, lapack_int lda, + float* t, lapack_int tsize ); +lapack_int LAPACKE_dgelq( int matrix_layout, lapack_int m, lapack_int n, + double* a, lapack_int lda, + double* t, lapack_int tsize ); +lapack_int LAPACKE_cgelq( int matrix_layout, lapack_int m, lapack_int n, + lapack_complex_float* a, lapack_int lda, + lapack_complex_float* t, lapack_int tsize ); +lapack_int LAPACKE_zgelq( int matrix_layout, lapack_int m, lapack_int n, + lapack_complex_double* a, lapack_int lda, + lapack_complex_double* t, lapack_int tsize ); + +lapack_int LAPACKE_sgelq_work( int matrix_layout, lapack_int m, lapack_int n, + float* a, lapack_int lda, + float* t, lapack_int tsize, + float* work, lapack_int lwork ); +lapack_int LAPACKE_dgelq_work( int matrix_layout, lapack_int m, lapack_int n, + double* a, lapack_int lda, + double* t, lapack_int tsize, + double* work, lapack_int lwork ); +lapack_int LAPACKE_cgelq_work( int matrix_layout, lapack_int m, lapack_int n, + lapack_complex_float* a, lapack_int lda, + lapack_complex_float* t, lapack_int tsize, + lapack_complex_float* work, lapack_int lwork ); +lapack_int LAPACKE_zgelq_work( int matrix_layout, lapack_int m, lapack_int n, + lapack_complex_double* a, lapack_int lda, + lapack_complex_double* t, lapack_int tsize, + lapack_complex_double* work, lapack_int lwork ); + +lapack_int LAPACKE_sgemlq( int matrix_layout, char side, char trans, + lapack_int m, lapack_int n, lapack_int k, + const float* a, lapack_int lda, + const float* t, lapack_int tsize, + float* c, lapack_int ldc ); +lapack_int LAPACKE_dgemlq( int matrix_layout, char side, char trans, + lapack_int m, lapack_int n, lapack_int k, + const double* a, lapack_int lda, + const double* t, lapack_int tsize, + double* c, lapack_int ldc ); +lapack_int LAPACKE_cgemlq( int matrix_layout, char side, char trans, + lapack_int m, lapack_int n, lapack_int k, + const lapack_complex_float* a, lapack_int lda, + const lapack_complex_float* t, lapack_int tsize, + lapack_complex_float* c, lapack_int ldc ); +lapack_int LAPACKE_zgemlq( int matrix_layout, char side, char trans, + lapack_int m, lapack_int n, lapack_int k, + const lapack_complex_double* a, lapack_int lda, + const lapack_complex_double* t, lapack_int tsize, + lapack_complex_double* c, lapack_int ldc ); + +lapack_int LAPACKE_sgemlq_work( int matrix_layout, char side, char trans, + lapack_int m, lapack_int n, lapack_int k, + const float* a, lapack_int lda, + const float* t, lapack_int tsize, + float* c, lapack_int ldc, + float* work, lapack_int lwork ); +lapack_int LAPACKE_dgemlq_work( int matrix_layout, char side, char trans, + lapack_int m, lapack_int n, lapack_int k, + const double* a, lapack_int lda, + const double* t, lapack_int tsize, + double* c, lapack_int ldc, + double* work, lapack_int lwork ); +lapack_int LAPACKE_cgemlq_work( int matrix_layout, char side, char trans, + lapack_int m, lapack_int n, lapack_int k, + const lapack_complex_float* a, lapack_int lda, + const lapack_complex_float* t, lapack_int tsize, + lapack_complex_float* c, lapack_int ldc, + lapack_complex_float* work, lapack_int lwork ); +lapack_int LAPACKE_zgemlq_work( int matrix_layout, char side, char trans, + lapack_int m, lapack_int n, lapack_int k, + const lapack_complex_double* a, lapack_int lda, + const lapack_complex_double* t, lapack_int tsize, + lapack_complex_double* c, lapack_int ldc, + lapack_complex_double* work, lapack_int lwork ); + +lapack_int LAPACKE_sgeqr( int matrix_layout, lapack_int m, lapack_int n, + float* a, lapack_int lda, + float* t, lapack_int tsize ); +lapack_int LAPACKE_dgeqr( int matrix_layout, lapack_int m, lapack_int n, + double* a, lapack_int lda, + double* t, lapack_int tsize ); +lapack_int LAPACKE_cgeqr( int matrix_layout, lapack_int m, lapack_int n, + lapack_complex_float* a, lapack_int lda, + lapack_complex_float* t, lapack_int tsize ); +lapack_int LAPACKE_zgeqr( int matrix_layout, lapack_int m, lapack_int n, + lapack_complex_double* a, lapack_int lda, + lapack_complex_double* t, lapack_int tsize ); + +lapack_int LAPACKE_sgeqr_work( int matrix_layout, lapack_int m, lapack_int n, + float* a, lapack_int lda, + float* t, lapack_int tsize, + float* work, lapack_int lwork ); +lapack_int LAPACKE_dgeqr_work( int matrix_layout, lapack_int m, lapack_int n, + double* a, lapack_int lda, + double* t, lapack_int tsize, + double* work, lapack_int lwork ); +lapack_int LAPACKE_cgeqr_work( int matrix_layout, lapack_int m, lapack_int n, + lapack_complex_float* a, lapack_int lda, + lapack_complex_float* t, lapack_int tsize, + lapack_complex_float* work, lapack_int lwork ); +lapack_int LAPACKE_zgeqr_work( int matrix_layout, lapack_int m, lapack_int n, + lapack_complex_double* a, lapack_int lda, + lapack_complex_double* t, lapack_int tsize, + lapack_complex_double* work, lapack_int lwork ); + +lapack_int LAPACKE_sgemqr( int matrix_layout, char side, char trans, + lapack_int m, lapack_int n, lapack_int k, + const float* a, lapack_int lda, + const float* t, lapack_int tsize, + float* c, lapack_int ldc ); +lapack_int LAPACKE_dgemqr( int matrix_layout, char side, char trans, + lapack_int m, lapack_int n, lapack_int k, + const double* a, lapack_int lda, + const double* t, lapack_int tsize, + double* c, lapack_int ldc ); +lapack_int LAPACKE_cgemqr( int matrix_layout, char side, char trans, + lapack_int m, lapack_int n, lapack_int k, + const lapack_complex_float* a, lapack_int lda, + const lapack_complex_float* t, lapack_int tsize, + lapack_complex_float* c, lapack_int ldc ); +lapack_int LAPACKE_zgemqr( int matrix_layout, char side, char trans, + lapack_int m, lapack_int n, lapack_int k, + const lapack_complex_double* a, lapack_int lda, + const lapack_complex_double* t, lapack_int tsize, + lapack_complex_double* c, lapack_int ldc ); + +lapack_int LAPACKE_sgemqr_work( int matrix_layout, char side, char trans, + lapack_int m, lapack_int n, lapack_int k, + const float* a, lapack_int lda, + const float* t, lapack_int tsize, + float* c, lapack_int ldc, + float* work, lapack_int lwork ); +lapack_int LAPACKE_dgemqr_work( int matrix_layout, char side, char trans, + lapack_int m, lapack_int n, lapack_int k, + const double* a, lapack_int lda, + const double* t, lapack_int tsize, + double* c, lapack_int ldc, + double* work, lapack_int lwork ); +lapack_int LAPACKE_cgemqr_work( int matrix_layout, char side, char trans, + lapack_int m, lapack_int n, lapack_int k, + const lapack_complex_float* a, lapack_int lda, + const lapack_complex_float* t, lapack_int tsize, + lapack_complex_float* c, lapack_int ldc, + lapack_complex_float* work, lapack_int lwork ); +lapack_int LAPACKE_zgemqr_work( int matrix_layout, char side, char trans, + lapack_int m, lapack_int n, lapack_int k, + const lapack_complex_double* a, lapack_int lda, + const lapack_complex_double* t, lapack_int tsize, + lapack_complex_double* c, lapack_int ldc, + lapack_complex_double* work, lapack_int lwork ); + +lapack_int LAPACKE_sgetsls( int matrix_layout, char trans, lapack_int m, + lapack_int n, lapack_int nrhs, float* a, + lapack_int lda, float* b, lapack_int ldb ); +lapack_int LAPACKE_dgetsls( int matrix_layout, char trans, lapack_int m, + lapack_int n, lapack_int nrhs, double* a, + lapack_int lda, double* b, lapack_int ldb ); +lapack_int LAPACKE_cgetsls( int matrix_layout, char trans, lapack_int m, + lapack_int n, lapack_int nrhs, + lapack_complex_float* a, lapack_int lda, + lapack_complex_float* b, lapack_int ldb ); +lapack_int LAPACKE_zgetsls( int matrix_layout, char trans, lapack_int m, + lapack_int n, lapack_int nrhs, + lapack_complex_double* a, lapack_int lda, + lapack_complex_double* b, lapack_int ldb ); + +lapack_int LAPACKE_sgetsls_work( int matrix_layout, char trans, lapack_int m, + lapack_int n, lapack_int nrhs, float* a, + lapack_int lda, float* b, lapack_int ldb, + float* work, lapack_int lwork ); +lapack_int LAPACKE_dgetsls_work( int matrix_layout, char trans, lapack_int m, + lapack_int n, lapack_int nrhs, double* a, + lapack_int lda, double* b, lapack_int ldb, + double* work, lapack_int lwork ); +lapack_int LAPACKE_cgetsls_work( int matrix_layout, char trans, lapack_int m, + lapack_int n, lapack_int nrhs, + lapack_complex_float* a, lapack_int lda, + lapack_complex_float* b, lapack_int ldb, + lapack_complex_float* work, lapack_int lwork ); +lapack_int LAPACKE_zgetsls_work( int matrix_layout, char trans, lapack_int m, + lapack_int n, lapack_int nrhs, + lapack_complex_double* a, lapack_int lda, + lapack_complex_double* b, lapack_int ldb, + lapack_complex_double* work, lapack_int lwork ); + #define LAPACK_sgetrf LAPACK_GLOBAL(sgetrf,SGETRF) #define LAPACK_dgetrf LAPACK_GLOBAL(dgetrf,DGETRF) #define LAPACK_cgetrf LAPACK_GLOBAL(cgetrf,CGETRF) @@ -12696,6 +13128,56 @@ lapack_int LAPACKE_zhetrs_aa_work( int matrix_layout, char uplo, lapack_int n, #define LAPACK_chetrf_aa LAPACK_GLOBAL(chetrf_aa,CHETRF_AA) #define LAPACK_zhetrf_aa LAPACK_GLOBAL(zhetrf_aa,ZHETRF_AA) +#define LAPACK_ssysv_rk LAPACK_GLOBAL(ssysv_rk,SSYSV_RK) +#define LAPACK_dsysv_rk LAPACK_GLOBAL(dsysv_rk,DSYSV_RK) +#define LAPACK_chesv_rk LAPACK_GLOBAL(chesv_rk,CHESV_RK) +#define LAPACK_zsysv_rk LAPACK_GLOBAL(zsysv_rk,ZSYSV_RK) +#define LAPACK_csysv_rk LAPACK_GLOBAL(csysv_rk,CSYSV_RK) +#define LAPACK_zhesv_rk LAPACK_GLOBAL(zhesv_rk,ZHESV_RK) +#define LAPACK_ssytrf_rk LAPACK_GLOBAL(ssytrf_rk,SSYTRF_RK) +#define LAPACK_dsytrf_rk LAPACK_GLOBAL(dsytrf_rk,DSYTRF_RK) +#define LAPACK_csytrf_rk LAPACK_GLOBAL(csytrf_rk,CSYTRF_RK) +#define LAPACK_zsytrf_rk LAPACK_GLOBAL(zsytrf_rk,ZSYTRF_RK) +#define LAPACK_chetrf_rk LAPACK_GLOBAL(chetrf_rk,CHETRF_RK) +#define LAPACK_zhetrf_rk LAPACK_GLOBAL(zhetrf_rk,ZHETRF_RK) +#define LAPACK_ssytrs_3 LAPACK_GLOBAL(ssytrs_3,SSYTRS_3) +#define LAPACK_dsytrs_3 LAPACK_GLOBAL(dsytrs_3,DSYTRS_3) +#define LAPACK_csytrs_3 LAPACK_GLOBAL(csytrs_3,CSYTRS_3) +#define LAPACK_zsytrs_3 LAPACK_GLOBAL(zsytrs_3,ZSYTRS_3) +#define LAPACK_chetrs_3 LAPACK_GLOBAL(chetrs_3,CHETRS_3) +#define LAPACK_zhetrs_3 LAPACK_GLOBAL(zhetrs_3,ZHETRS_3) +#define LAPACK_ssytri_3 LAPACK_GLOBAL(ssytri_3,SSYTRI_3) +#define LAPACK_dsytri_3 LAPACK_GLOBAL(dsytri_3,DSYTRI_3) +#define LAPACK_csytri_3 LAPACK_GLOBAL(csytri_3,CSYTRI_3) +#define LAPACK_zsytri_3 LAPACK_GLOBAL(zsytri_3,ZSYTRI_3) +#define LAPACK_chetri_3 LAPACK_GLOBAL(chetri_3,CHETRI_3) +#define LAPACK_zhetri_3 LAPACK_GLOBAL(zhetri_3,ZHETRI_3) +#define LAPACK_ssycon_3 LAPACK_GLOBAL(ssycon_3,SSYCON_3) +#define LAPACK_dsycon_3 LAPACK_GLOBAL(dsycon_3,DSYCON_3) +#define LAPACK_csycon_3 LAPACK_GLOBAL(csycon_3,CSYCON_3) +#define LAPACK_zsycon_3 LAPACK_GLOBAL(zsycon_3,ZSYCON_3) +#define LAPACK_checon_3 LAPACK_GLOBAL(checon_3,CHECON_3) +#define LAPACK_zhecon_3 LAPACK_GLOBAL(zhecon_3,ZHECON_3) +#define LAPACK_sgelq LAPACK_GLOBAL(sgelq,SGELQ) +#define LAPACK_dgelq LAPACK_GLOBAL(dgelq,DGELQ) +#define LAPACK_cgelq LAPACK_GLOBAL(cgelq,CGELQ) +#define LAPACK_zgelq LAPACK_GLOBAL(zgelq,ZGELQ) +#define LAPACK_sgemlq LAPACK_GLOBAL(sgemlq,SGEMLQ) +#define LAPACK_dgemlq LAPACK_GLOBAL(dgemlq,DGEMLQ) +#define LAPACK_cgemlq LAPACK_GLOBAL(cgemlq,CGEMLQ) +#define LAPACK_zgemlq LAPACK_GLOBAL(zgemlq,ZGEMLQ) +#define LAPACK_sgeqr LAPACK_GLOBAL(sgeqr,SGEQR) +#define LAPACK_dgeqr LAPACK_GLOBAL(dgeqr,DGEQR) +#define LAPACK_cgeqr LAPACK_GLOBAL(cgeqr,CGEQR) +#define LAPACK_zgeqr LAPACK_GLOBAL(zgeqr,ZGEQR) +#define LAPACK_sgemqr LAPACK_GLOBAL(sgemqr,SGEMQR) +#define LAPACK_dgemqr LAPACK_GLOBAL(dgemqr,DGEMQR) +#define LAPACK_cgemqr LAPACK_GLOBAL(cgemqr,CGEMQR) +#define LAPACK_zgemqr LAPACK_GLOBAL(zgemqr,ZGEMQR) +#define LAPACK_sgetsls LAPACK_GLOBAL(sgetsls,SGETSLS) +#define LAPACK_dgetsls LAPACK_GLOBAL(dgetsls,DGETSLS) +#define LAPACK_cgetsls LAPACK_GLOBAL(cgetsls,CGETSLS) +#define LAPACK_zgetsls LAPACK_GLOBAL(zgetsls,ZGETSLS) void LAPACK_sgetrf( lapack_int* m, lapack_int* n, float* a, lapack_int* lda, @@ -17793,6 +18275,224 @@ void LAPACK_zhetrs_aa( char* uplo, lapack_int* n, lapack_complex_double* b, lapack_int* ldb, lapack_complex_double* work, lapack_int* lwork, lapack_int *info ); +void LAPACK_ssysv_rk( char* uplo, lapack_int* n, lapack_int* nrhs, float* a, + lapack_int* lda, float* e, lapack_int* ipiv, float* b, lapack_int* ldb, + float* work, lapack_int* lwork, lapack_int *info ); +void LAPACK_dsysv_rk( char* uplo, lapack_int* n, lapack_int* nrhs, double* a, + lapack_int* lda, double* e, lapack_int* ipiv, double* b, + lapack_int* ldb, double* work, lapack_int* lwork, + lapack_int *info ); +void LAPACK_csysv_rk( char* uplo, lapack_int* n, lapack_int* nrhs, + lapack_complex_float* a, lapack_int* lda, + lapack_complex_float* e, lapack_int* ipiv, + lapack_complex_float* b, lapack_int* ldb, + lapack_complex_float* work, lapack_int* lwork, + lapack_int *info ); +void LAPACK_zsysv_rk( char* uplo, lapack_int* n, lapack_int* nrhs, + lapack_complex_double* a, lapack_int* lda, + lapack_complex_double* e, lapack_int* ipiv, + lapack_complex_double* b, lapack_int* ldb, + lapack_complex_double* work, lapack_int* lwork, + lapack_int *info ); +void LAPACK_chesv_rk( char* uplo, lapack_int* n, lapack_int* nrhs, + lapack_complex_float* a, lapack_int* lda, + lapack_complex_float* e, lapack_int* ipiv, + lapack_complex_float* b, lapack_int* ldb, + lapack_complex_float* work, lapack_int* lwork, + lapack_int *info ); +void LAPACK_zhesv_rk( char* uplo, lapack_int* n, lapack_int* nrhs, + lapack_complex_double* a, lapack_int* lda, + lapack_complex_double* e, lapack_int* ipiv, + lapack_complex_double* b, lapack_int* ldb, + lapack_complex_double* work, lapack_int* lwork, + lapack_int *info ); + +void LAPACK_ssytrf_rk( char* uplo, lapack_int* n, float* a, lapack_int* lda, + float* e, lapack_int* ipiv, float* work, lapack_int* lwork, + lapack_int *info ); +void LAPACK_dsytrf_rk( char* uplo, lapack_int* n, double* a, lapack_int* lda, + double* e, lapack_int* ipiv, double* work, lapack_int* lwork, + lapack_int *info ); +void LAPACK_csytrf_rk( char* uplo, lapack_int* n, lapack_complex_float* a, + lapack_int* lda, lapack_complex_float* e, lapack_int* ipiv, + lapack_complex_float* work, lapack_int* lwork, + lapack_int *info ); +void LAPACK_zsytrf_rk( char* uplo, lapack_int* n, lapack_complex_double* a, + lapack_int* lda, lapack_complex_double* e, lapack_int* ipiv, + lapack_complex_double* work, lapack_int* lwork, + lapack_int *info ); +void LAPACK_chetrf_rk( char* uplo, lapack_int* n, lapack_complex_float* a, + lapack_int* lda, lapack_complex_float* e, lapack_int* ipiv, + lapack_complex_float* work, lapack_int* lwork, + lapack_int *info ); +void LAPACK_zhetrf_rk( char* uplo, lapack_int* n, lapack_complex_double* a, + lapack_int* lda, lapack_complex_double* e, lapack_int* ipiv, + lapack_complex_double* work, lapack_int* lwork, + lapack_int *info ); + +void LAPACK_ssytrs_3( char* uplo, lapack_int* n, + lapack_int* nrhs, const float* a, + lapack_int* lda, const float* e, const lapack_int* ipiv, + float* b, lapack_int* ldb, lapack_int *info ); +void LAPACK_dsytrs_3( char* uplo, lapack_int* n, + lapack_int* nrhs, const double* a, + lapack_int* lda, const double* e, const lapack_int* ipiv, + double* b, lapack_int* ldb, lapack_int *info ); +void LAPACK_csytrs_3( char* uplo, lapack_int* n, + lapack_int* nrhs, const lapack_complex_float* a, + lapack_int* lda, const lapack_complex_float* e, + const lapack_int* ipiv, + lapack_complex_float* b, lapack_int* ldb, lapack_int *info ); +void LAPACK_zsytrs_3( char* uplo, lapack_int* n, + lapack_int* nrhs, + const lapack_complex_double* a, lapack_int* lda, + const lapack_complex_double* e, const lapack_int* ipiv, + lapack_complex_double* b, lapack_int* ldb, lapack_int *info ); +void LAPACK_chetrs_3( char* uplo, lapack_int* n, + lapack_int* nrhs, const lapack_complex_float* a, + lapack_int* lda, const lapack_complex_float* e, + const lapack_int* ipiv, + lapack_complex_float* b, lapack_int* ldb, lapack_int *info ); +void LAPACK_zhetrs_3( char* uplo, lapack_int* n, + lapack_int* nrhs, + const lapack_complex_double* a, lapack_int* lda, + const lapack_complex_double* e, + const lapack_int* ipiv, + lapack_complex_double* b, lapack_int* ldb, lapack_int *info ); + +void LAPACK_ssytri_3( char* uplo, lapack_int* n, float* a, lapack_int* lda, const float* e, + const lapack_int* ipiv, float* work, lapack_int* lwork, lapack_int *info ); +void LAPACK_dsytri_3( char* uplo, lapack_int* n, double* a, lapack_int* lda, const double* e, + const lapack_int* ipiv, double* work, lapack_int* lwork, lapack_int *info ); +void LAPACK_csytri_3( char* uplo, lapack_int* n, lapack_complex_float* a, + lapack_int* lda, const lapack_complex_float* e, const lapack_int* ipiv, + lapack_complex_float* work, lapack_int* lwork, lapack_int *info ); +void LAPACK_zsytri_3( char* uplo, lapack_int* n, lapack_complex_double* a, + lapack_int* lda, const lapack_complex_double* e, const lapack_int* ipiv, + lapack_complex_double* work, lapack_int* lwork, lapack_int *info ); +void LAPACK_chetri_3( char* uplo, lapack_int* n, lapack_complex_float* a, + lapack_int* lda, const lapack_complex_float* e, const lapack_int* ipiv, + lapack_complex_float* work, lapack_int* lwork, lapack_int *info ); +void LAPACK_zhetri_3( char* uplo, lapack_int* n, lapack_complex_double* a, + lapack_int* lda, const lapack_complex_double* e, const lapack_int* ipiv, + lapack_complex_double* work, lapack_int* lwork, lapack_int *info ); + +void LAPACK_ssycon_3( char* uplo, lapack_int* n, const float* a, lapack_int* lda, const float* e, + const lapack_int* ipiv, float* anorm, float* rcond, + float* work, lapack_int* iwork, lapack_int *info ); +void LAPACK_dsycon_3( char* uplo, lapack_int* n, const double* a, lapack_int* lda, const double* e, + const lapack_int* ipiv, double* anorm, double* rcond, + double* work, lapack_int* iwork, lapack_int *info ); +void LAPACK_csycon_3( char* uplo, lapack_int* n, const lapack_complex_float* a, + lapack_int* lda, const lapack_complex_float* e, const lapack_int* ipiv, float* anorm, + float* rcond, lapack_complex_float* work, + lapack_int *info ); +void LAPACK_zsycon_3( char* uplo, lapack_int* n, const lapack_complex_double* a, + lapack_int* lda, const lapack_complex_double* e, const lapack_int* ipiv, double* anorm, + double* rcond, lapack_complex_double* work, + lapack_int *info ); +void LAPACK_checon_3( char* uplo, lapack_int* n, const lapack_complex_float* a, + lapack_int* lda, const lapack_complex_float* e, const lapack_int* ipiv, float* anorm, + float* rcond, lapack_complex_float* work, + lapack_int *info ); +void LAPACK_zhecon_3( char* uplo, lapack_int* n, const lapack_complex_double* a, + lapack_int* lda, const lapack_complex_double* e, const lapack_int* ipiv, double* anorm, + double* rcond, lapack_complex_double* work, + lapack_int *info ); + +void LAPACK_sgelq( lapack_int* m, lapack_int* n, float* a, lapack_int* lda, + float* t, lapack_int* tsize, float* work, lapack_int* lwork, + lapack_int* info ); +void LAPACK_dgelq( lapack_int* m, lapack_int* n, double* a, lapack_int* lda, + double* t, lapack_int* tsize, double* work, lapack_int* lwork, + lapack_int* info ); +void LAPACK_cgelq( lapack_int* m, lapack_int* n, lapack_complex_float* a, lapack_int* lda, + lapack_complex_float* t, lapack_int* tsize, lapack_complex_float* work, lapack_int* lwork, + lapack_int* info ); +void LAPACK_zgelq( lapack_int* m, lapack_int* n, lapack_complex_double* a, lapack_int* lda, + lapack_complex_double* t, lapack_int* tsize, lapack_complex_double* work, lapack_int* lwork, + lapack_int* info ); + +void LAPACK_sgemlq( char* side, char* trans, lapack_int* m, lapack_int* n, lapack_int* k, + const float* a, lapack_int* lda, + const float* t, lapack_int* tsize, + float* c, lapack_int* ldc, + float* work, lapack_int* lwork, + lapack_int* info ); +void LAPACK_dgemlq( char* side, char* trans, lapack_int* m, lapack_int* n, lapack_int* k, + const double* a, lapack_int* lda, + const double* t, lapack_int* tsize, + double* c, lapack_int* ldc, + double* work, lapack_int* lwork, + lapack_int* info ); +void LAPACK_cgemlq( char* side, char* trans, lapack_int* m, lapack_int* n, lapack_int* k, + const lapack_complex_float* a, lapack_int* lda, + const lapack_complex_float* t, lapack_int* tsize, + lapack_complex_float* c, lapack_int* ldc, + lapack_complex_float* work, lapack_int* lwork, + lapack_int* info ); +void LAPACK_zgemlq( char* side, char* trans, lapack_int* m, lapack_int* n, lapack_int* k, + const lapack_complex_double* a, lapack_int* lda, + const lapack_complex_double* t, lapack_int* tsize, + lapack_complex_double* c, lapack_int* ldc, + lapack_complex_double* work, lapack_int* lwork, + lapack_int* info ); + +void LAPACK_sgeqr( lapack_int* m, lapack_int* n, float* a, lapack_int* lda, + float* t, lapack_int* tsize, float* work, lapack_int* lwork, + lapack_int* info ); +void LAPACK_dgeqr( lapack_int* m, lapack_int* n, double* a, lapack_int* lda, + double* t, lapack_int* tsize, double* work, lapack_int* lwork, + lapack_int* info ); +void LAPACK_cgeqr( lapack_int* m, lapack_int* n, lapack_complex_float* a, lapack_int* lda, + lapack_complex_float* t, lapack_int* tsize, lapack_complex_float* work, lapack_int* lwork, + lapack_int* info ); +void LAPACK_zgeqr( lapack_int* m, lapack_int* n, lapack_complex_double* a, lapack_int* lda, + lapack_complex_double* t, lapack_int* tsize, lapack_complex_double* work, lapack_int* lwork, + lapack_int* info ); + +void LAPACK_sgemqr( char* side, char* trans, lapack_int* m, lapack_int* n, lapack_int* k, + const float* a, lapack_int* lda, + const float* t, lapack_int* tsize, + float* c, lapack_int* ldc, + float* work, lapack_int* lwork, + lapack_int* info ); +void LAPACK_dgemqr( char* side, char* trans, lapack_int* m, lapack_int* n, lapack_int* k, + const double* a, lapack_int* lda, + const double* t, lapack_int* tsize, + double* c, lapack_int* ldc, + double* work, lapack_int* lwork, + lapack_int* info ); +void LAPACK_cgemqr( char* side, char* trans, lapack_int* m, lapack_int* n, lapack_int* k, + const lapack_complex_float* a, lapack_int* lda, + const lapack_complex_float* t, lapack_int* tsize, + lapack_complex_float* c, lapack_int* ldc, + lapack_complex_float* work, lapack_int* lwork, + lapack_int* info ); +void LAPACK_zgemqr( char* side, char* trans, lapack_int* m, lapack_int* n, lapack_int* k, + const lapack_complex_double* a, lapack_int* lda, + const lapack_complex_double* t, lapack_int* tsize, + lapack_complex_double* c, lapack_int* ldc, + lapack_complex_double* work, lapack_int* lwork, + lapack_int* info ); + +void LAPACK_sgetsls( char* trans, lapack_int* m, lapack_int* n, lapack_int* nrhs, + float* a, lapack_int* lda, float* b, lapack_int* ldb, + float* work, lapack_int* lwork, lapack_int *info ); +void LAPACK_dgetsls( char* trans, lapack_int* m, lapack_int* n, lapack_int* nrhs, + double* a, lapack_int* lda, double* b, lapack_int* ldb, + double* work, lapack_int* lwork, lapack_int *info ); +void LAPACK_cgetsls( char* trans, lapack_int* m, lapack_int* n, lapack_int* nrhs, + lapack_complex_float* a, lapack_int* lda, + lapack_complex_float* b, lapack_int* ldb, + lapack_complex_float* work, lapack_int* lwork, + lapack_int *info ); +void LAPACK_zgetsls( char* trans, lapack_int* m, lapack_int* n, lapack_int* nrhs, + lapack_complex_double* a, lapack_int* lda, + lapack_complex_double* b, lapack_int* ldb, + lapack_complex_double* work, lapack_int* lwork, + lapack_int *info ); + #ifdef __cplusplus } #endif /* __cplusplus */ diff --git a/LAPACKE/src/CMakeLists.txt b/LAPACKE/src/CMakeLists.txt index 5ebebbaf..0f5b0baf 100644 --- a/LAPACKE/src/CMakeLists.txt +++ b/LAPACKE/src/CMakeLists.txt @@ -59,6 +59,8 @@ lapacke_cgelss.c lapacke_cgelss_work.c lapacke_cgelsy.c lapacke_cgelsy_work.c +lapacke_cgemqr.c +lapacke_cgemqr_work.c lapacke_cgemqrt.c lapacke_cgemqrt_work.c lapacke_cgeqlf.c @@ -103,6 +105,8 @@ lapacke_cgetri.c lapacke_cgetri_work.c lapacke_cgetrs.c lapacke_cgetrs_work.c +lapacke_cgetsls.c +lapacke_cgetsls_work.c lapacke_cggbak.c lapacke_cggbak_work.c lapacke_cggbal.c @@ -165,6 +169,8 @@ lapacke_chbtrd.c lapacke_chbtrd_work.c lapacke_checon.c lapacke_checon_work.c +lapacke_checon_3.c +lapacke_checon_3_work.c lapacke_cheequb.c lapacke_cheequb_work.c lapacke_cheev.c @@ -189,6 +195,8 @@ lapacke_chesv.c lapacke_chesv_work.c lapacke_chesv_aa.c lapacke_chesv_aa_work.c +lapacke_chesv_rk.c +lapacke_chesv_rk_work.c lapacke_chesvx.c lapacke_chesvx_work.c lapacke_cheswapr.c @@ -201,9 +209,13 @@ lapacke_chetrf_work.c lapacke_chetrf_rook_work.c lapacke_chetrf_aa.c lapacke_chetrf_aa_work.c +lapacke_chetrf_rk.c +lapacke_chetrf_rk_work.c lapacke_chetri.c lapacke_chetri2.c lapacke_chetri2_work.c +lapacke_chetri_3.c +lapacke_chetri_3_work.c lapacke_chetri2x.c lapacke_chetri2x_work.c lapacke_chetri_work.c @@ -215,6 +227,8 @@ lapacke_chetrs_work.c lapacke_chetrs_rook_work.c lapacke_chetrs_aa.c lapacke_chetrs_aa_work.c +lapacke_chetrs_3.c +lapacke_chetrs_3_work.c lapacke_chfrk.c lapacke_chfrk_work.c lapacke_chgeqz.c @@ -393,6 +407,8 @@ lapacke_csteqr.c lapacke_csteqr_work.c lapacke_csycon.c lapacke_csycon_work.c +lapacke_csycon_3.c +lapacke_csycon_3_work.c lapacke_csyconv.c lapacke_csyconv_work.c lapacke_csyequb.c @@ -405,6 +421,8 @@ lapacke_csysv_rook_work.c lapacke_csysv_work.c lapacke_csysv_aa.c lapacke_csysv_aa_work.c +lapacke_csysv_rk.c +lapacke_csysv_rk_work.c lapacke_csysvx.c lapacke_csysvx_work.c lapacke_csyswapr.c @@ -415,9 +433,13 @@ lapacke_csytrf_rook.c lapacke_csytrf_rook_work.c lapacke_csytrf_aa.c lapacke_csytrf_aa_work.c +lapacke_csytrf_rk.c +lapacke_csytrf_rk_work.c lapacke_csytri.c lapacke_csytri2.c lapacke_csytri2_work.c +lapacke_csytri_3.c +lapacke_csytri_3_work.c lapacke_csytri2x.c lapacke_csytri2x_work.c lapacke_csytri_work.c @@ -429,6 +451,8 @@ lapacke_csytrs_work.c lapacke_csytrs_rook_work.c lapacke_csytrs_aa.c lapacke_csytrs_aa_work.c +lapacke_csytrs_3.c +lapacke_csytrs_3_work.c lapacke_ctbcon.c lapacke_ctbcon_work.c lapacke_ctbrfs.c @@ -603,6 +627,8 @@ lapacke_dgelss.c lapacke_dgelss_work.c lapacke_dgelsy.c lapacke_dgelsy_work.c +lapacke_dgemqr.c +lapacke_dgemqr_work.c lapacke_dgemqrt.c lapacke_dgemqrt_work.c lapacke_dgeqlf.c @@ -647,6 +673,8 @@ lapacke_dgetri.c lapacke_dgetri_work.c lapacke_dgetrs.c lapacke_dgetrs_work.c +lapacke_dgetsls.c +lapacke_dgetsls_work.c lapacke_dggbak.c lapacke_dggbak_work.c lapacke_dggbal.c @@ -933,6 +961,8 @@ lapacke_dstevx.c lapacke_dstevx_work.c lapacke_dsycon.c lapacke_dsycon_work.c +lapacke_dsycon_3.c +lapacke_dsycon_3_work.c lapacke_dsyconv.c lapacke_dsyconv_work.c lapacke_dsyequb.c @@ -961,6 +991,8 @@ lapacke_dsysv_rook_work.c lapacke_dsysv_work.c lapacke_dsysv_aa.c lapacke_dsysv_aa_work.c +lapacke_dsysv_rk.c +lapacke_dsysv_rk_work.c lapacke_dsysvx.c lapacke_dsysvx_work.c lapacke_dsyswapr.c @@ -973,9 +1005,13 @@ lapacke_dsytrf_rook.c lapacke_dsytrf_rook_work.c lapacke_dsytrf_aa.c lapacke_dsytrf_aa_work.c +lapacke_dsytrf_rk.c +lapacke_dsytrf_rk_work.c lapacke_dsytri.c lapacke_dsytri2.c lapacke_dsytri2_work.c +lapacke_dsytri_3.c +lapacke_dsytri_3_work.c lapacke_dsytri2x.c lapacke_dsytri2x_work.c lapacke_dsytri_work.c @@ -985,6 +1021,8 @@ lapacke_dsytrs2.c lapacke_dsytrs2_work.c lapacke_dsytrs_aa.c lapacke_dsytrs_aa_work.c +lapacke_dsytrs_3.c +lapacke_dsytrs_3_work.c lapacke_dsytrs_work.c lapacke_dsytrs_rook_work.c lapacke_dtbcon.c @@ -1121,6 +1159,8 @@ lapacke_sgelss.c lapacke_sgelss_work.c lapacke_sgelsy.c lapacke_sgelsy_work.c +lapacke_sgemqr.c +lapacke_sgemqr_work.c lapacke_sgemqrt.c lapacke_sgemqrt_work.c lapacke_sgeqlf.c @@ -1165,6 +1205,8 @@ lapacke_sgetri.c lapacke_sgetri_work.c lapacke_sgetrs.c lapacke_sgetrs_work.c +lapacke_sgetsls.c +lapacke_sgetsls_work.c lapacke_sggbak.c lapacke_sggbak_work.c lapacke_sggbal.c @@ -1447,6 +1489,8 @@ lapacke_sstevx.c lapacke_sstevx_work.c lapacke_ssycon.c lapacke_ssycon_work.c +lapacke_ssycon_3.c +lapacke_ssycon_3_work.c lapacke_ssyconv.c lapacke_ssyconv_work.c lapacke_ssyequb.c @@ -1475,6 +1519,8 @@ lapacke_ssysv_rook_work.c lapacke_ssysv_work.c lapacke_ssysv_aa.c lapacke_ssysv_aa_work.c +lapacke_ssysv_rk.c +lapacke_ssysv_rk_work.c lapacke_ssysvx.c lapacke_ssysvx_work.c lapacke_ssyswapr.c @@ -1487,9 +1533,13 @@ lapacke_ssytrf_rook.c lapacke_ssytrf_rook_work.c lapacke_ssytrf_aa.c lapacke_ssytrf_aa_work.c +lapacke_ssytrf_rk.c +lapacke_ssytrf_rk_work.c lapacke_ssytri.c lapacke_ssytri2.c lapacke_ssytri2_work.c +lapacke_ssytri_3.c +lapacke_ssytri_3_work.c lapacke_ssytri2x.c lapacke_ssytri2x_work.c lapacke_ssytri_work.c @@ -1499,6 +1549,8 @@ lapacke_ssytrs2.c lapacke_ssytrs2_work.c lapacke_ssytrs_aa.c lapacke_ssytrs_aa_work.c +lapacke_ssytrs_3.c +lapacke_ssytrs_3_work.c lapacke_ssytrs_work.c lapacke_ssytrs_rook_work.c lapacke_stbcon.c @@ -1633,6 +1685,8 @@ lapacke_zgelss.c lapacke_zgelss_work.c lapacke_zgelsy.c lapacke_zgelsy_work.c +lapacke_zgemqr.c +lapacke_zgemqr_work.c lapacke_zgemqrt.c lapacke_zgemqrt_work.c lapacke_zgeqlf.c @@ -1677,6 +1731,8 @@ lapacke_zgetri.c lapacke_zgetri_work.c lapacke_zgetrs.c lapacke_zgetrs_work.c +lapacke_zgetsls.c +lapacke_zgetsls_work.c lapacke_zggbak.c lapacke_zggbak_work.c lapacke_zggbal.c @@ -1739,6 +1795,8 @@ lapacke_zhbtrd.c lapacke_zhbtrd_work.c lapacke_zhecon.c lapacke_zhecon_work.c +lapacke_zhecon_3.c +lapacke_zhecon_3_work.c lapacke_zheequb.c lapacke_zheequb_work.c lapacke_zheev.c @@ -1763,6 +1821,8 @@ lapacke_zhesv.c lapacke_zhesv_work.c lapacke_zhesv_aa.c lapacke_zhesv_aa_work.c +lapacke_zhesv_rk.c +lapacke_zhesv_rk_work.c lapacke_zhesvx.c lapacke_zhesvx_work.c lapacke_zheswapr.c @@ -1775,9 +1835,13 @@ lapacke_zhetrf_work.c lapacke_zhetrf_rook_work.c lapacke_zhetrf_aa.c lapacke_zhetrf_aa_work.c +lapacke_zhetrf_rk.c +lapacke_zhetrf_rk_work.c lapacke_zhetri.c lapacke_zhetri2.c lapacke_zhetri2_work.c +lapacke_zhetri_3.c +lapacke_zhetri_3_work.c lapacke_zhetri2x.c lapacke_zhetri2x_work.c lapacke_zhetri_work.c @@ -1788,6 +1852,8 @@ lapacke_zhetrs2_work.c lapacke_zhetrs_work.c lapacke_zhetrs_aa.c lapacke_zhetrs_aa_work.c +lapacke_zhetrs_3.c +lapacke_zhetrs_3_work.c lapacke_zhetrs_rook_work.c lapacke_zhfrk.c lapacke_zhfrk_work.c @@ -1967,6 +2033,8 @@ lapacke_zsteqr.c lapacke_zsteqr_work.c lapacke_zsycon.c lapacke_zsycon_work.c +lapacke_zsycon_3.c +lapacke_zsycon_3_work.c lapacke_zsyconv.c lapacke_zsyconv_work.c lapacke_zsyequb.c @@ -1979,6 +2047,8 @@ lapacke_zsysv_rook_work.c lapacke_zsysv_work.c lapacke_zsysv_aa.c lapacke_zsysv_aa_work.c +lapacke_zsysv_rk.c +lapacke_zsysv_rk_work.c lapacke_zsysvx.c lapacke_zsysvx_work.c lapacke_zsyswapr.c @@ -1989,9 +2059,13 @@ lapacke_zsytrf_rook.c lapacke_zsytrf_rook_work.c lapacke_zsytrf_aa.c lapacke_zsytrf_aa_work.c +lapacke_zsytrf_rk.c +lapacke_zsytrf_rk_work.c lapacke_zsytri.c lapacke_zsytri2.c lapacke_zsytri2_work.c +lapacke_zsytri_3.c +lapacke_zsytri_3_work.c lapacke_zsytri2x.c lapacke_zsytri2x_work.c lapacke_zsytri_work.c @@ -2003,6 +2077,8 @@ lapacke_zsytrs_work.c lapacke_zsytrs_rook_work.c lapacke_zsytrs_aa.c lapacke_zsytrs_aa_work.c +lapacke_zsytrs_3.c +lapacke_zsytrs_3_work.c lapacke_ztbcon.c lapacke_ztbcon_work.c lapacke_ztbrfs.c diff --git a/LAPACKE/src/Makefile b/LAPACKE/src/Makefile index e3266aed..f32be2ee 100644 --- a/LAPACKE/src/Makefile +++ b/LAPACKE/src/Makefile @@ -93,6 +93,8 @@ lapacke_cgelss.o \ lapacke_cgelss_work.o \ lapacke_cgelsy.o \ lapacke_cgelsy_work.o \ +lapacke_cgemqr.o \ +lapacke_cgemqr_work.o \ lapacke_cgemqrt.o \ lapacke_cgemqrt_work.o \ lapacke_cgeqlf.o \ @@ -137,6 +139,8 @@ lapacke_cgetri.o \ lapacke_cgetri_work.o \ lapacke_cgetrs.o \ lapacke_cgetrs_work.o \ +lapacke_cgetsls.o \ +lapacke_cgetsls_work.o \ lapacke_cggbak.o \ lapacke_cggbak_work.o \ lapacke_cggbal.o \ @@ -199,6 +203,8 @@ lapacke_chbtrd.o \ lapacke_chbtrd_work.o \ lapacke_checon.o \ lapacke_checon_work.o \ +lapacke_checon_3.o \ +lapacke_checon_3_work.o \ lapacke_cheequb.o \ lapacke_cheequb_work.o \ lapacke_cheev.o \ @@ -223,6 +229,8 @@ lapacke_chesv.o \ lapacke_chesv_work.o \ lapacke_chesv_aa.o \ lapacke_chesv_aa_work.o \ +lapacke_chesv_rk.o \ +lapacke_chesv_rk_work.o \ lapacke_chesvx.o \ lapacke_chesvx_work.o \ lapacke_cheswapr.o \ @@ -235,9 +243,13 @@ lapacke_chetrf_work.o \ lapacke_chetrf_rook_work.o \ lapacke_chetrf_aa.o \ lapacke_chetrf_aa_work.o \ +lapacke_chetrf_rk.o \ +lapacke_chetrf_rk_work.o \ lapacke_chetri.o \ lapacke_chetri2.o \ lapacke_chetri2_work.o \ +lapacke_chetri_3.o \ +lapacke_chetri_3_work.o \ lapacke_chetri2x.o \ lapacke_chetri2x_work.o \ lapacke_chetri_work.o \ @@ -249,6 +261,8 @@ lapacke_chetrs_work.o \ lapacke_chetrs_rook_work.o \ lapacke_chetrs_aa.o \ lapacke_chetrs_aa_work.o \ +lapacke_chetrs_3.o \ +lapacke_chetrs_3_work.o \ lapacke_chfrk.o \ lapacke_chfrk_work.o \ lapacke_chgeqz.o \ @@ -427,6 +441,8 @@ lapacke_csteqr.o \ lapacke_csteqr_work.o \ lapacke_csycon.o \ lapacke_csycon_work.o \ +lapacke_csycon_3.o \ +lapacke_csycon_3_work.o \ lapacke_csyconv.o \ lapacke_csyconv_work.o \ lapacke_csyequb.o \ @@ -439,6 +455,8 @@ lapacke_csysv_rook_work.o \ lapacke_csysv_work.o \ lapacke_csysv_aa.o \ lapacke_csysv_aa_work.o \ +lapacke_csysv_rk.o \ +lapacke_csysv_rk_work.o \ lapacke_csysvx.o \ lapacke_csysvx_work.o \ lapacke_csyswapr.o \ @@ -449,9 +467,13 @@ lapacke_csytrf_rook.o \ lapacke_csytrf_rook_work.o \ lapacke_csytrf_aa.o \ lapacke_csytrf_aa_work.o \ +lapacke_csytrf_rk.o \ +lapacke_csytrf_rk_work.o \ lapacke_csytri.o \ lapacke_csytri2.o \ lapacke_csytri2_work.o \ +lapacke_csytri_3.o \ +lapacke_csytri_3_work.o \ lapacke_csytri2x.o \ lapacke_csytri2x_work.o \ lapacke_csytri_work.o \ @@ -463,6 +485,8 @@ lapacke_csytrs_work.o \ lapacke_csytrs_rook_work.o \ lapacke_csytrs_aa.o \ lapacke_csytrs_aa_work.o \ +lapacke_csytrs_3.o \ +lapacke_csytrs_3_work.o \ lapacke_ctbcon.o \ lapacke_ctbcon_work.o \ lapacke_ctbrfs.o \ @@ -637,6 +661,8 @@ lapacke_dgelss.o \ lapacke_dgelss_work.o \ lapacke_dgelsy.o \ lapacke_dgelsy_work.o \ +lapacke_dgemqr.o \ +lapacke_dgemqr_work.o \ lapacke_dgemqrt.o \ lapacke_dgemqrt_work.o \ lapacke_dgeqlf.o \ @@ -681,6 +707,8 @@ lapacke_dgetri.o \ lapacke_dgetri_work.o \ lapacke_dgetrs.o \ lapacke_dgetrs_work.o \ +lapacke_dgetsls.o \ +lapacke_dgetsls_work.o \ lapacke_dggbak.o \ lapacke_dggbak_work.o \ lapacke_dggbal.o \ @@ -967,6 +995,8 @@ lapacke_dstevx.o \ lapacke_dstevx_work.o \ lapacke_dsycon.o \ lapacke_dsycon_work.o \ +lapacke_dsycon_3.o \ +lapacke_dsycon_3_work.o \ lapacke_dsyconv.o \ lapacke_dsyconv_work.o \ lapacke_dsyequb.o \ @@ -995,6 +1025,8 @@ lapacke_dsysv_rook_work.o \ lapacke_dsysv_work.o \ lapacke_dsysv_aa.o \ lapacke_dsysv_aa_work.o \ +lapacke_dsysv_rk.o \ +lapacke_dsysv_rk_work.o \ lapacke_dsysvx.o \ lapacke_dsysvx_work.o \ lapacke_dsyswapr.o \ @@ -1007,9 +1039,13 @@ lapacke_dsytrf_rook.o \ lapacke_dsytrf_rook_work.o \ lapacke_dsytrf_aa.o \ lapacke_dsytrf_aa_work.o \ +lapacke_dsytrf_rk.o \ +lapacke_dsytrf_rk_work.o \ lapacke_dsytri.o \ lapacke_dsytri2.o \ lapacke_dsytri2_work.o \ +lapacke_dsytri_3.o \ +lapacke_dsytri_3_work.o \ lapacke_dsytri2x.o \ lapacke_dsytri2x_work.o \ lapacke_dsytri_work.o \ @@ -1021,6 +1057,8 @@ lapacke_dsytrs_work.o \ lapacke_dsytrs_rook_work.o \ lapacke_dsytrs_aa.o \ lapacke_dsytrs_aa_work.o \ +lapacke_dsytrs_3.o \ +lapacke_dsytrs_3_work.o \ lapacke_dtbcon.o \ lapacke_dtbcon_work.o \ lapacke_dtbrfs.o \ @@ -1155,6 +1193,8 @@ lapacke_sgelss.o \ lapacke_sgelss_work.o \ lapacke_sgelsy.o \ lapacke_sgelsy_work.o \ +lapacke_sgemqr.o \ +lapacke_sgemqr_work.o \ lapacke_sgemqrt.o \ lapacke_sgemqrt_work.o \ lapacke_sgeqlf.o \ @@ -1199,6 +1239,8 @@ lapacke_sgetri.o \ lapacke_sgetri_work.o \ lapacke_sgetrs.o \ lapacke_sgetrs_work.o \ +lapacke_sgetsls.o \ +lapacke_sgetsls_work.o \ lapacke_sggbak.o \ lapacke_sggbak_work.o \ lapacke_sggbal.o \ @@ -1481,6 +1523,8 @@ lapacke_sstevx.o \ lapacke_sstevx_work.o \ lapacke_ssycon.o \ lapacke_ssycon_work.o \ +lapacke_ssycon_3.o \ +lapacke_ssycon_3_work.o \ lapacke_ssyconv.o \ lapacke_ssyconv_work.o \ lapacke_ssyequb.o \ @@ -1509,6 +1553,8 @@ lapacke_ssysv_rook_work.o \ lapacke_ssysv_work.o \ lapacke_ssysv_aa.o \ lapacke_ssysv_aa_work.o \ +lapacke_ssysv_rk.o \ +lapacke_ssysv_rk_work.o \ lapacke_ssysvx.o \ lapacke_ssysvx_work.o \ lapacke_ssyswapr.o \ @@ -1521,9 +1567,13 @@ lapacke_ssytrf_rook.o \ lapacke_ssytrf_rook_work.o \ lapacke_ssytrf_aa.o \ lapacke_ssytrf_aa_work.o \ +lapacke_ssytrf_rk.o \ +lapacke_ssytrf_rk_work.o \ lapacke_ssytri.o \ lapacke_ssytri2.o \ lapacke_ssytri2_work.o \ +lapacke_ssytri_3.o \ +lapacke_ssytri_3_work.o \ lapacke_ssytri2x.o \ lapacke_ssytri2x_work.o \ lapacke_ssytri_work.o \ @@ -1535,6 +1585,8 @@ lapacke_ssytrs_work.o \ lapacke_ssytrs_rook_work.o \ lapacke_ssytrs_aa.o \ lapacke_ssytrs_aa_work.o \ +lapacke_ssytrs_3.o \ +lapacke_ssytrs_3_work.o \ lapacke_stbcon.o \ lapacke_stbcon_work.o \ lapacke_stbrfs.o \ @@ -1667,6 +1719,8 @@ lapacke_zgelss.o \ lapacke_zgelss_work.o \ lapacke_zgelsy.o \ lapacke_zgelsy_work.o \ +lapacke_zgemqr.o \ +lapacke_zgemqr_work.o \ lapacke_zgemqrt.o \ lapacke_zgemqrt_work.o \ lapacke_zgeqlf.o \ @@ -1711,6 +1765,8 @@ lapacke_zgetri.o \ lapacke_zgetri_work.o \ lapacke_zgetrs.o \ lapacke_zgetrs_work.o \ +lapacke_zgetsls.o \ +lapacke_zgetsls_work.o \ lapacke_zggbak.o \ lapacke_zggbak_work.o \ lapacke_zggbal.o \ @@ -1773,6 +1829,8 @@ lapacke_zhbtrd.o \ lapacke_zhbtrd_work.o \ lapacke_zhecon.o \ lapacke_zhecon_work.o \ +lapacke_zhecon_3.o \ +lapacke_zhecon_3_work.o \ lapacke_zheequb.o \ lapacke_zheequb_work.o \ lapacke_zheev.o \ @@ -1797,6 +1855,8 @@ lapacke_zhesv.o \ lapacke_zhesv_work.o \ lapacke_zhesv_aa.o \ lapacke_zhesv_aa_work.o \ +lapacke_zhesv_rk.o \ +lapacke_zhesv_rk_work.o \ lapacke_zhesvx.o \ lapacke_zhesvx_work.o \ lapacke_zheswapr.o \ @@ -1809,9 +1869,13 @@ lapacke_zhetrf_work.o \ lapacke_zhetrf_rook_work.o \ lapacke_zhetrf_aa.o \ lapacke_zhetrf_aa_work.o \ +lapacke_zhetrf_rk.o \ +lapacke_zhetrf_rk_work.o \ lapacke_zhetri.o \ lapacke_zhetri2.o \ lapacke_zhetri2_work.o \ +lapacke_zhetri_3.o \ +lapacke_zhetri_3_work.o \ lapacke_zhetri2x.o \ lapacke_zhetri2x_work.o \ lapacke_zhetri_work.o \ @@ -1823,6 +1887,8 @@ lapacke_zhetrs_work.o \ lapacke_zhetrs_rook_work.o \ lapacke_zhetrs_aa.o \ lapacke_zhetrs_aa_work.o \ +lapacke_zhetrs_3.o \ +lapacke_zhetrs_3_work.o \ lapacke_zhfrk.o \ lapacke_zhfrk_work.o \ lapacke_zhgeqz.o \ @@ -2001,6 +2067,8 @@ lapacke_zsteqr.o \ lapacke_zsteqr_work.o \ lapacke_zsycon.o \ lapacke_zsycon_work.o \ +lapacke_zsycon_3.o \ +lapacke_zsycon_3_work.o \ lapacke_zsyconv.o \ lapacke_zsyconv_work.o \ lapacke_zsyequb.o \ @@ -2013,6 +2081,8 @@ lapacke_zsysv_rook_work.o \ lapacke_zsysv_work.o \ lapacke_zsysv_aa.o \ lapacke_zsysv_aa_work.o \ +lapacke_zsysv_rk.o \ +lapacke_zsysv_rk_work.o \ lapacke_zsysvx.o \ lapacke_zsysvx_work.o \ lapacke_zsyswapr.o \ @@ -2023,9 +2093,13 @@ lapacke_zsytrf_rook.o \ lapacke_zsytrf_rook_work.o \ lapacke_zsytrf_aa.o \ lapacke_zsytrf_aa_work.o \ +lapacke_zsytrf_rk.o \ +lapacke_zsytrf_rk_work.o \ lapacke_zsytri.o \ lapacke_zsytri2.o \ lapacke_zsytri2_work.o \ +lapacke_zsytri_3.o \ +lapacke_zsytri_3_work.o \ lapacke_zsytri2x.o \ lapacke_zsytri2x_work.o \ lapacke_zsytri_work.o \ @@ -2037,6 +2111,8 @@ lapacke_zsytrs_work.o \ lapacke_zsytrs_rook_work.o \ lapacke_zsytrs_aa.o \ lapacke_zsytrs_aa_work.o \ +lapacke_zsytrs_3.o \ +lapacke_zsytrs_3_work.o \ lapacke_ztbcon.o \ lapacke_ztbcon_work.o \ lapacke_ztbrfs.o \ diff --git a/LAPACKE/src/lapacke_cgelq.c b/LAPACKE/src/lapacke_cgelq.c new file mode 100644 index 00000000..0d23bce7 --- /dev/null +++ b/LAPACKE/src/lapacke_cgelq.c @@ -0,0 +1,79 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native high-level C interface to LAPACK function cgelq +* Author: Intel Corporation +* Generated November 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_cgelq_work( int matrix_layout, lapack_int m, lapack_int n, + lapack_complex_float* a, lapack_int lda, + lapack_complex_float* t, lapack_int tsize ) +{ + lapack_int info = 0; + lapack_int lwork = -1; + lapack_complex_float* work = NULL; + lapack_complex_float work_query; + if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { + LAPACKE_xerbla( "LAPACKE_cgelq", -1 ); + return -1; + } +#ifndef LAPACK_DISABLE_NAN_CHECK + /* Optionally check input matrices for NaNs */ + if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) { + return -4; + } +#endif + /* Query optimal working array(s) size */ + info = LAPACKE_cgelq_work( matrix_layout, m, n, a, lda, t, tsize, &work_query, + lwork ); + if( info != 0 ) { + goto exit_level_0; + } + if( tsize == -1 || tsize == -2 ) { + goto exit_level_0; + } + lwork = (lapack_int)work_query; + /* Allocate memory for work arrays */ + work = (lapack_complex_float*)LAPACKE_malloc( sizeof(lapack_complex_float) * lwork ); + if( work == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_0; + } + /* Call middle-level interface */ + info = LAPACKE_cgelq_work( matrix_layout, m, n, a, lda, t, tsize, work, lwork ); + /* Release memory and exit */ + LAPACKE_free( work ); +exit_level_0: + if( info == LAPACK_WORK_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_cgelq", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_cgelq_work.c b/LAPACKE/src/lapacke_cgelq_work.c new file mode 100644 index 00000000..dd56097d --- /dev/null +++ b/LAPACKE/src/lapacke_cgelq_work.c @@ -0,0 +1,88 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native middle-level C interface to LAPACK function cgelq +* Author: Intel Corporation +* Generated November 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_cgelq_work( int matrix_layout, lapack_int m, lapack_int n, + lapack_complex_float* a, lapack_int lda, + lapack_complex_float* t, lapack_int tsize, + lapack_complex_float* work, lapack_int lwork ) +{ + lapack_int info = 0; + if( matrix_layout == LAPACK_COL_MAJOR ) { + /* Call LAPACK function and adjust info */ + LAPACK_cgelq( &m, &n, a, &lda, t, &tsize, work, &lwork, &info ); + if( info < 0 ) { + info = info - 1; + } + } else if( matrix_layout == LAPACK_ROW_MAJOR ) { + lapack_int lda_t = MAX(1,m); + lapack_complex_float* a_t = NULL; + /* Check leading dimension(s) */ + if( lda < n ) { + info = -5; + LAPACKE_xerbla( "LAPACKE_cgelq_work", info ); + return info; + } + /* Query optimal working array(s) size if requested */ + if( tsize == -1 || tsize == -2 || lwork == -1 || lwork == -2) { + LAPACK_cgelq( &m, &n, a, &lda_t, t, &tsize, work, &lwork, &info ); + return (info < 0) ? (info - 1) : 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; + } + /* Transpose input matrices */ + LAPACKE_cge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + /* Call LAPACK function and adjust info */ + LAPACK_cgelq( &m, &n, a_t, &lda_t, t, &tsize, work, &lwork, &info ); + if( info < 0 ) { + info = info - 1; + } + /* Transpose output matrices */ + LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + /* Release memory and exit */ + LAPACKE_free( a_t ); +exit_level_0: + if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_cgelq_work", info ); + } + } else { + info = -1; + LAPACKE_xerbla( "LAPACKE_cgelq_work", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_cgemlq.c b/LAPACKE/src/lapacke_cgemlq.c new file mode 100644 index 00000000..0fbaa8a0 --- /dev/null +++ b/LAPACKE/src/lapacke_cgemlq.c @@ -0,0 +1,85 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native high-level C interface to LAPACK function cgemlq +* Author: Intel Corporation +* Generated November 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_cgemlq( int matrix_layout, char side, char trans, + lapack_int m, lapack_int n, lapack_int k, + const lapack_complex_float* a, lapack_int lda, + const lapack_complex_float* t, lapack_int tsize, + lapack_complex_float* c, lapack_int ldc ) +{ + lapack_int info = 0; + lapack_int lwork = -1; + lapack_complex_float* work = NULL; + lapack_complex_float work_query; + if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { + LAPACKE_xerbla( "LAPACKE_cgemlq", -1 ); + return -1; + } +#ifndef LAPACK_DISABLE_NAN_CHECK + /* Optionally check input matrices for NaNs */ + if( LAPACKE_cge_nancheck( matrix_layout, k, m, a, lda ) ) { + return -7; + } + if( LAPACKE_cge_nancheck( matrix_layout, m, n, c, ldc ) ) { + return -10; + } + if( LAPACKE_d_nancheck( tsize, t, 1 ) ) { + return -9; + } +#endif + /* Query optimal working array(s) size */ + info = LAPACKE_cgemlq_work( matrix_layout, side, trans, m, n, k, a, lda, + t, tsize, c, ldc, &work_query, lwork ); + if( info != 0 ) { + goto exit_level_0; + } + lwork = (lapack_int)work_query; + /* Allocate memory for work arrays */ + work = (lapack_complex_float*)LAPACKE_malloc( sizeof(lapack_complex_float) * lwork ); + if( work == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_0; + } + /* Call middle-level interface */ + info = LAPACKE_cgemlq_work( matrix_layout, side, trans, m, n, k, a, lda, + t, tsize, c, ldc, work, lwork ); + /* Release memory and exit */ + LAPACKE_free( work ); +exit_level_0: + if( info == LAPACK_WORK_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_cgemlq", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_cgemlq_work.c b/LAPACKE/src/lapacke_cgemlq_work.c new file mode 100644 index 00000000..e2f7fc91 --- /dev/null +++ b/LAPACKE/src/lapacke_cgemlq_work.c @@ -0,0 +1,114 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native middle-level C interface to LAPACK function cgemlq +* Author: Intel Corporation +* Generated June 2016 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_cgemlq_work( int matrix_layout, char side, char trans, + lapack_int m, lapack_int n, lapack_int k, + const lapack_complex_float* a, lapack_int lda, + const lapack_complex_float* t, lapack_int tsize, + lapack_complex_float* c, lapack_int ldc, + lapack_complex_float* work, lapack_int lwork ) +{ + lapack_int info = 0; + lapack_int r; + lapack_int lda_t, ldc_t; + lapack_complex_float *a_t = NULL, *c_t = NULL; + if( matrix_layout == LAPACK_COL_MAJOR ) { + /* Call LAPACK function and adjust info */ + LAPACK_cgemlq( &side, &trans, &m, &n, &k, a, &lda, t, &tsize, + c, &ldc, work, &lwork, &info ); + if( info < 0 ) { + info = info - 1; + } + } else if( matrix_layout == LAPACK_ROW_MAJOR ) { + r = LAPACKE_lsame( side, 'l' ) ? m : n; + lda_t = MAX(1,k); + ldc_t = MAX(1,m); + /* Check leading dimension(s) */ + if( lda < r ) { + info = -8; + LAPACKE_xerbla( "LAPACKE_cgemlq_work", info ); + return info; + } + if( ldc < n ) { + info = -11; + LAPACKE_xerbla( "LAPACKE_cgemlq_work", info ); + return info; + } + /* Query optimal working array(s) size if requested */ + if( lwork == -1 ) { + LAPACK_cgemlq( &side, &trans, &m, &n, &k, a, &lda_t, t, &tsize, + c, &ldc_t, work, &lwork, &info ); + return (info < 0) ? (info - 1) : info; + } + /* Allocate memory for temporary array(s) */ + if( LAPACKE_lsame( side, 'l' ) ) { + a_t = (lapack_complex_float*)LAPACKE_malloc( sizeof(lapack_complex_float) * lda_t * MAX(1,m) ); + } else { + 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; + } + c_t = (lapack_complex_float*)LAPACKE_malloc( sizeof(lapack_complex_float) * ldc_t * MAX(1,n) ); + if( c_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_1; + } + /* Transpose input matrices */ + LAPACKE_cge_trans( matrix_layout, k, m, a, lda, a_t, lda_t ); + LAPACKE_cge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t ); + /* Call LAPACK function and adjust info */ + LAPACK_cgemlq( &side, &trans, &m, &n, &k, a_t, &lda_t, t, &tsize, + c_t, &ldc_t, work, &lwork, &info ); + if( info < 0 ) { + info = info - 1; + } + /* Transpose output matrices */ + LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); + /* Release memory and exit */ + LAPACKE_free( c_t ); +exit_level_1: + LAPACKE_free( a_t ); +exit_level_0: + if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_cgemlq_work", info ); + } + } else { + info = -1; + LAPACKE_xerbla( "LAPACKE_cgemlq_work", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_cgemqr.c b/LAPACKE/src/lapacke_cgemqr.c new file mode 100644 index 00000000..229a4132 --- /dev/null +++ b/LAPACKE/src/lapacke_cgemqr.c @@ -0,0 +1,88 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native high-level C interface to LAPACK function cgemqr +* Author: Intel Corporation +* Generated December 2016 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_cgemqr( int matrix_layout, char side, char trans, + lapack_int m, lapack_int n, lapack_int k, + const lapack_complex_float* a, lapack_int lda, + const lapack_complex_float* t, lapack_int tsize, + lapack_complex_float* c, lapack_int ldc ) +{ + lapack_int info = 0; + lapack_int lwork = -1; + lapack_complex_float* work = NULL; + lapack_complex_float work_query; + lapack_int r; + if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { + LAPACKE_xerbla( "LAPACKE_cgemqr", -1 ); + return -1; + } +#ifndef LAPACK_DISABLE_NAN_CHECK + /* Optionally check input matrices for NaNs */ + r = LAPACKE_lsame( side, 'l' ) ? m : n; + if( LAPACKE_cge_nancheck( matrix_layout, r, k, a, lda ) ) { + return -7; + } + if( LAPACKE_cge_nancheck( matrix_layout, m, n, c, ldc ) ) { + return -10; + } + if( LAPACKE_c_nancheck( tsize, t, 1 ) ) { + return -9; + } +#endif + /* Query optimal working array(s) size */ + info = LAPACKE_cgemqr_work( matrix_layout, side, trans, m, n, k, a, lda, + t, tsize, c, ldc, &work_query, lwork ); + if( info != 0 ) { + goto exit_level_0; + } + lwork = LAPACK_C2INT( work_query ); + /* Allocate memory for work arrays */ + work = (lapack_complex_float*) + LAPACKE_malloc( sizeof(lapack_complex_float) * lwork ); + if( work == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_0; + } + /* Call middle-level interface */ + info = LAPACKE_cgemqr_work( matrix_layout, side, trans, m, n, k, a, lda, + t, tsize, c, ldc, work, lwork ); + /* Release memory and exit */ + LAPACKE_free( work ); +exit_level_0: + if( info == LAPACK_WORK_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_cgemqr", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_cgemqr_work.c b/LAPACKE/src/lapacke_cgemqr_work.c new file mode 100644 index 00000000..9b9e5a44 --- /dev/null +++ b/LAPACKE/src/lapacke_cgemqr_work.c @@ -0,0 +1,112 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native middle-level C interface to LAPACK function cgemqr +* Author: Intel Corporation +* Generated December 2016 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_cgemqr_work( int matrix_layout, char side, char trans, + lapack_int m, lapack_int n, lapack_int k, + const lapack_complex_float* a, lapack_int lda, + const lapack_complex_float* t, lapack_int tsize, + lapack_complex_float* c, lapack_int ldc, + lapack_complex_float* work, lapack_int lwork ) +{ + lapack_int info = 0; + lapack_int r; + lapack_int lda_t, ldc_t; + lapack_complex_float *a_t = NULL, *c_t = NULL; + if( matrix_layout == LAPACK_COL_MAJOR ) { + /* Call LAPACK function and adjust info */ + LAPACK_cgemqr( &side, &trans, &m, &n, &k, a, &lda, t, &tsize, c, &ldc, + work, &lwork, &info ); + if( info < 0 ) { + info = info - 1; + } + } else if( matrix_layout == LAPACK_ROW_MAJOR ) { + r = LAPACKE_lsame( side, 'l' ) ? m : n; + lda_t = MAX(1,r); + ldc_t = MAX(1,m); + /* Check leading dimension(s) */ + if( lda < k ) { + info = -8; + LAPACKE_xerbla( "LAPACKE_cgemqr_work", info ); + return info; + } + if( ldc < n ) { + info = -11; + LAPACKE_xerbla( "LAPACKE_cgemqr_work", info ); + return info; + } + /* Query optimal working array(s) size if requested */ + if( lwork == -1 ) { + LAPACK_cgemqr( &side, &trans, &m, &n, &k, a, &lda_t, t, &tsize, + c, &ldc_t, work, &lwork, &info ); + return (info < 0) ? (info - 1) : info; + } + /* Allocate memory for temporary array(s) */ + a_t = (lapack_complex_float*) + LAPACKE_malloc( sizeof(lapack_complex_float) * lda_t * MAX(1,k) ); + if( a_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_0; + } + c_t = (lapack_complex_float*) + LAPACKE_malloc( sizeof(lapack_complex_float) * ldc_t * MAX(1,n) ); + if( c_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_1; + } + /* Transpose input matrices */ + LAPACKE_cge_trans( matrix_layout, r, k, a, lda, a_t, lda_t ); + LAPACKE_cge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t ); + /* Call LAPACK function and adjust info */ + LAPACK_cgemqr( &side, &trans, &m, &n, &k, a_t, &lda_t, t, &tsize, + c_t, &ldc_t, work, &lwork, &info ); + if( info < 0 ) { + info = info - 1; + } + /* Transpose output matrices */ + LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); + /* Release memory and exit */ + LAPACKE_free( c_t ); +exit_level_1: + LAPACKE_free( a_t ); +exit_level_0: + if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_cgemqr_work", info ); + } + } else { + info = -1; + LAPACKE_xerbla( "LAPACKE_cgemqr_work", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_cgeqr.c b/LAPACKE/src/lapacke_cgeqr.c new file mode 100644 index 00000000..beabeb8f --- /dev/null +++ b/LAPACKE/src/lapacke_cgeqr.c @@ -0,0 +1,80 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native high-level C interface to LAPACK function cgeqr +* Author: Intel Corporation +* Generated December 2016 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_cgeqr( int matrix_layout, lapack_int m, lapack_int n, + lapack_complex_float* a, lapack_int lda, + lapack_complex_float* t, lapack_int tsize ) +{ + lapack_int info = 0; + lapack_int lwork = -1; + lapack_complex_float* work = NULL; + lapack_complex_float work_query; + if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { + LAPACKE_xerbla( "LAPACKE_cgeqr", -1 ); + return -1; + } +#ifndef LAPACK_DISABLE_NAN_CHECK + /* Optionally check input matrices for NaNs */ + if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) { + return -4; + } +#endif + /* Query optimal working array(s) size */ + info = LAPACKE_cgeqr_work( matrix_layout, m, n, a, lda, t, tsize, &work_query, + lwork ); + if( info != 0 ) { + goto exit_level_0; + } + if( tsize == -1 || tsize == -2 ) { + goto exit_level_0; + } + lwork = (lapack_int)work_query; + /* Allocate memory for work arrays */ + work = (lapack_complex_float*) + LAPACKE_malloc( sizeof(lapack_complex_float) * lwork ); + if( work == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_0; + } + /* Call middle-level interface */ + info = LAPACKE_cgeqr_work( matrix_layout, m, n, a, lda, t, tsize, work, lwork ); + /* Release memory and exit */ + LAPACKE_free( work ); +exit_level_0: + if( info == LAPACK_WORK_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_cgeqr", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_cgeqr_work.c b/LAPACKE/src/lapacke_cgeqr_work.c new file mode 100644 index 00000000..ff5cc9bc --- /dev/null +++ b/LAPACKE/src/lapacke_cgeqr_work.c @@ -0,0 +1,89 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native middle-level C interface to LAPACK function cgeqr +* Author: Intel Corporation +* Generated December 2016 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_cgeqr_work( int matrix_layout, lapack_int m, lapack_int n, + lapack_complex_float* a, lapack_int lda, + lapack_complex_float* t, lapack_int tsize, + lapack_complex_float* work, lapack_int lwork ) +{ + lapack_int info = 0; + if( matrix_layout == LAPACK_COL_MAJOR ) { + /* Call LAPACK function and adjust info */ + LAPACK_cgeqr( &m, &n, a, &lda, t, &tsize, work, &lwork, &info ); + if( info < 0 ) { + info = info - 1; + } + } else if( matrix_layout == LAPACK_ROW_MAJOR ) { + lapack_int lda_t = MAX(1,m); + lapack_complex_float* a_t = NULL; + /* Check leading dimension(s) */ + if( lda < n ) { + info = -5; + LAPACKE_xerbla( "LAPACKE_cgeqr_work", info ); + return info; + } + /* Query optimal working array(s) size if requested */ + if( tsize == -1 || tsize == -2 || lwork == -1 || lwork == -2) { + LAPACK_cgeqr( &m, &n, a, &lda_t, t, &tsize, work, &lwork, &info ); + return (info < 0) ? (info - 1) : 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; + } + /* Transpose input matrices */ + LAPACKE_cge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + /* Call LAPACK function and adjust info */ + LAPACK_cgeqr( &m, &n, a_t, &lda_t, t, &tsize, work, &lwork, &info ); + if( info < 0 ) { + info = info - 1; + } + /* Transpose output matrices */ + LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + /* Release memory and exit */ + LAPACKE_free( a_t ); +exit_level_0: + if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_cgeqr_work", info ); + } + } else { + info = -1; + LAPACKE_xerbla( "LAPACKE_cgeqr_work", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_cgetsls.c b/LAPACKE/src/lapacke_cgetsls.c new file mode 100644 index 00000000..8b35c105 --- /dev/null +++ b/LAPACKE/src/lapacke_cgetsls.c @@ -0,0 +1,82 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native high-level C interface to LAPACK function cgetsls +* Author: Intel Corporation +* Generated December 2016 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_cgetsls( int matrix_layout, char trans, lapack_int m, + lapack_int n, lapack_int nrhs, + lapack_complex_float* a, lapack_int lda, + lapack_complex_float* b, lapack_int ldb ) +{ + lapack_int info = 0; + lapack_int lwork = -1; + lapack_complex_float* work = NULL; + lapack_complex_float work_query; + if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { + LAPACKE_xerbla( "LAPACKE_cgetsls", -1 ); + return -1; + } +#ifndef LAPACK_DISABLE_NAN_CHECK + /* Optionally check input matrices for NaNs */ + if( LAPACKE_cge_nancheck( matrix_layout, m, n, a, lda ) ) { + return -6; + } + if( LAPACKE_cge_nancheck( matrix_layout, MAX(m,n), nrhs, b, ldb ) ) { + return -8; + } +#endif + /* Query optimal working array(s) size */ + info = LAPACKE_cgetsls_work( matrix_layout, trans, m, n, nrhs, a, lda, b, ldb, + &work_query, lwork ); + if( info != 0 ) { + goto exit_level_0; + } + lwork = LAPACK_C2INT( work_query ); + /* Allocate memory for work arrays */ + work = (lapack_complex_float*) + LAPACKE_malloc( sizeof(lapack_complex_float) * lwork ); + if( work == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_0; + } + /* Call middle-level interface */ + info = LAPACKE_cgetsls_work( matrix_layout, trans, m, n, nrhs, a, lda, b, ldb, + work, lwork ); + /* Release memory and exit */ + LAPACKE_free( work ); +exit_level_0: + if( info == LAPACK_WORK_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_cgetsls", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_cgetsls_work.c b/LAPACKE/src/lapacke_cgetsls_work.c new file mode 100644 index 00000000..8f2ed4d0 --- /dev/null +++ b/LAPACKE/src/lapacke_cgetsls_work.c @@ -0,0 +1,112 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native middle-level C interface to LAPACK function cgetsls +* Author: Intel Corporation +* Generated December 2016 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_cgetsls_work( int matrix_layout, char trans, lapack_int m, + lapack_int n, lapack_int nrhs, + lapack_complex_float* a, lapack_int lda, + lapack_complex_float* b, lapack_int ldb, + lapack_complex_float* work, lapack_int lwork ) +{ + lapack_int info = 0; + if( matrix_layout == LAPACK_COL_MAJOR ) { + /* Call LAPACK function and adjust info */ + LAPACK_cgetsls( &trans, &m, &n, &nrhs, a, &lda, b, &ldb, work, &lwork, + &info ); + if( info < 0 ) { + info = info - 1; + } + } else if( matrix_layout == LAPACK_ROW_MAJOR ) { + lapack_int lda_t = MAX(1,m); + lapack_int ldb_t = MAX(1,MAX(m,n)); + lapack_complex_float* a_t = NULL; + lapack_complex_float* b_t = NULL; + /* Check leading dimension(s) */ + if( lda < n ) { + info = -7; + LAPACKE_xerbla( "LAPACKE_cgetsls_work", info ); + return info; + } + if( ldb < nrhs ) { + info = -9; + LAPACKE_xerbla( "LAPACKE_cgetsls_work", info ); + return info; + } + /* Query optimal working array(s) size if requested */ + if( lwork == -1 ) { + LAPACK_cgetsls( &trans, &m, &n, &nrhs, a, &lda_t, b, &ldb_t, work, + &lwork, &info ); + return (info < 0) ? (info - 1) : 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; + } + b_t = (lapack_complex_float*) + LAPACKE_malloc( sizeof(lapack_complex_float) * + ldb_t * MAX(1,nrhs) ); + if( b_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 ); + LAPACKE_cge_trans( matrix_layout, MAX(m,n), nrhs, b, ldb, b_t, ldb_t ); + /* Call LAPACK function and adjust info */ + LAPACK_cgetsls( &trans, &m, &n, &nrhs, a_t, &lda_t, b_t, &ldb_t, work, + &lwork, &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, MAX(m,n), nrhs, b_t, ldb_t, b, + ldb ); + /* Release memory and exit */ + LAPACKE_free( b_t ); +exit_level_1: + LAPACKE_free( a_t ); +exit_level_0: + if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_cgetsls_work", info ); + } + } else { + info = -1; + LAPACKE_xerbla( "LAPACKE_cgetsls_work", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_checon_3.c b/LAPACKE/src/lapacke_checon_3.c new file mode 100644 index 00000000..984d69e9 --- /dev/null +++ b/LAPACKE/src/lapacke_checon_3.c @@ -0,0 +1,76 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native high-level C interface to LAPACK function checon_3 +* Author: Intel Corporation +* Generated November 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_checon_3( int matrix_layout, char uplo, lapack_int n, + const lapack_complex_float* a, lapack_int lda, + const lapack_complex_float* e, + const lapack_int* ipiv, float anorm, float* rcond ) +{ + lapack_int info = 0; + lapack_complex_float* work = NULL; + if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { + LAPACKE_xerbla( "LAPACKE_checon_3", -1 ); + return -1; + } +#ifndef LAPACK_DISABLE_NAN_CHECK + /* Optionally check input matrices for NaNs */ + if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) { + return -4; + } + if( LAPACKE_c_nancheck( n, e, 1 ) ) { + return -6; + } + if( LAPACKE_s_nancheck( 1, &anorm, 1 ) ) { + return -8; + } +#endif + /* Allocate memory for working array(s) */ + work = (lapack_complex_float*) + LAPACKE_malloc( sizeof(lapack_complex_float) * MAX(1,2*n) ); + if( work == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_0; + } + /* Call middle-level interface */ + info = LAPACKE_checon_3_work( matrix_layout, uplo, n, a, lda, e, ipiv, anorm, + rcond, work ); + /* Release memory and exit */ + LAPACKE_free( work ); +exit_level_0: + if( info == LAPACK_WORK_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_checon_3", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_checon_3_work.c b/LAPACKE/src/lapacke_checon_3_work.c new file mode 100644 index 00000000..ed166998 --- /dev/null +++ b/LAPACKE/src/lapacke_checon_3_work.c @@ -0,0 +1,84 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native middle-level C interface to LAPACK function checon_3 +* Author: Intel Corporation +* Generated November 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_checon_3_work( int matrix_layout, char uplo, lapack_int n, + const lapack_complex_float* a, lapack_int lda, + const lapack_complex_float* e, + const lapack_int* ipiv, float anorm, + float* rcond, lapack_complex_float* work ) +{ + lapack_int info = 0; + if( matrix_layout == LAPACK_COL_MAJOR ) { + /* Call LAPACK function and adjust info */ + LAPACK_checon_3( &uplo, &n, a, &lda, e, ipiv, &anorm, rcond, work, &info ); + if( info < 0 ) { + info = info - 1; + } + } else if( matrix_layout == LAPACK_ROW_MAJOR ) { + lapack_int lda_t = MAX(1,n); + lapack_complex_float* a_t = NULL; + /* Check leading dimension(s) */ + if( lda < n ) { + info = -5; + LAPACKE_xerbla( "LAPACKE_checon_3_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; + } + /* Transpose input matrices */ + LAPACKE_che_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + /* Call LAPACK function and adjust info */ + LAPACK_checon_3( &uplo, &n, a_t, &lda_t, e, ipiv, &anorm, rcond, work, + &info ); + if( info < 0 ) { + info = info - 1; + } + /* Release memory and exit */ + LAPACKE_free( a_t ); +exit_level_0: + if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_checon_3_work", info ); + } + } else { + info = -1; + LAPACKE_xerbla( "LAPACKE_checon_3_work", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_chesv_rk.c b/LAPACKE/src/lapacke_chesv_rk.c new file mode 100644 index 00000000..442dbeaa --- /dev/null +++ b/LAPACKE/src/lapacke_chesv_rk.c @@ -0,0 +1,86 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native high-level C interface to LAPACK function chesv_rk +* Author: Intel Corporation +* Generated November 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_chesv_rk( int matrix_layout, char uplo, lapack_int n, + lapack_int nrhs, lapack_complex_float* a, + lapack_int lda, lapack_complex_float* e, + lapack_int* ipiv, + lapack_complex_float* b, lapack_int ldb ) +{ + lapack_int info = 0; + lapack_int lwork = -1; + lapack_complex_float* work = NULL; + lapack_complex_float work_query; + if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { + LAPACKE_xerbla( "LAPACKE_chesv_rk", -1 ); + return -1; + } +#ifndef LAPACK_DISABLE_NAN_CHECK + /* Optionally check input matrices for NaNs */ + if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) { + return -5; + } + if( LAPACKE_c_nancheck( n, e, 1) ) { + return -7; + } + if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + return -10; + } +#endif + /* Query optimal working array(s) size */ + info = LAPACKE_chesv_rk_work( matrix_layout, uplo, n, nrhs, a, lda, e, ipiv, b, + ldb, &work_query, lwork ); + if( info != 0 ) { + goto exit_level_0; + } + lwork = LAPACK_C2INT( work_query ); + /* Allocate memory for work arrays */ + work = (lapack_complex_float*) + LAPACKE_malloc( sizeof(lapack_complex_float) * lwork ); + if( work == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_0; + } + /* Call middle-level interface */ + info = LAPACKE_chesv_rk_work( matrix_layout, uplo, n, nrhs, a, lda, e, ipiv, b, + ldb, work, lwork ); + /* Release memory and exit */ + LAPACKE_free( work ); +exit_level_0: + if( info == LAPACK_WORK_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_chesv_rk", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_chesv_rk_work.c b/LAPACKE/src/lapacke_chesv_rk_work.c new file mode 100644 index 00000000..97ec3321 --- /dev/null +++ b/LAPACKE/src/lapacke_chesv_rk_work.c @@ -0,0 +1,112 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native middle-level C interface to LAPACK function chesv_rk +* Author: Intel Corporation +* Generated November 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_chesv_rk_work( int matrix_layout, char uplo, lapack_int n, + lapack_int nrhs, lapack_complex_float* a, + lapack_int lda, lapack_complex_float* e, + lapack_int* ipiv, + lapack_complex_float* b, lapack_int ldb, + lapack_complex_float* work, lapack_int lwork ) +{ + lapack_int info = 0; + if( matrix_layout == LAPACK_COL_MAJOR ) { + /* Call LAPACK function and adjust info */ + LAPACK_chesv_rk( &uplo, &n, &nrhs, a, &lda, e, ipiv, b, &ldb, work, &lwork, + &info ); + if( info < 0 ) { + info = info - 1; + } + } else if( matrix_layout == LAPACK_ROW_MAJOR ) { + lapack_int lda_t = MAX(1,n); + lapack_int ldb_t = MAX(1,n); + lapack_complex_float* a_t = NULL; + lapack_complex_float* b_t = NULL; + /* Check leading dimension(s) */ + if( lda < n ) { + info = -6; + LAPACKE_xerbla( "LAPACKE_chesv_rk_work", info ); + return info; + } + if( ldb < nrhs ) { + info = -10; + LAPACKE_xerbla( "LAPACKE_chesv_rk_work", info ); + return info; + } + /* Query optimal working array(s) size if requested */ + if( lwork == -1 ) { + LAPACK_chesv_rk( &uplo, &n, &nrhs, a, &lda_t, e, ipiv, b, &ldb_t, work, + &lwork, &info ); + return (info < 0) ? (info - 1) : 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; + } + b_t = (lapack_complex_float*) + LAPACKE_malloc( sizeof(lapack_complex_float) * + ldb_t * MAX(1,nrhs) ); + if( b_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_1; + } + /* Transpose input matrices */ + LAPACKE_che_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + /* Call LAPACK function and adjust info */ + LAPACK_chesv_rk( &uplo, &n, &nrhs, a_t, &lda_t, e, ipiv, b_t, &ldb_t, work, + &lwork, &info ); + if( info < 0 ) { + info = info - 1; + } + /* Transpose output matrices */ + LAPACKE_che_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + /* Release memory and exit */ + LAPACKE_free( b_t ); +exit_level_1: + LAPACKE_free( a_t ); +exit_level_0: + if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_chesv_rk_work", info ); + } + } else { + info = -1; + LAPACKE_xerbla( "LAPACKE_chesv_rk_work", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_chetrf_rk.c b/LAPACKE/src/lapacke_chetrf_rk.c new file mode 100644 index 00000000..477d8bdb --- /dev/null +++ b/LAPACKE/src/lapacke_chetrf_rk.c @@ -0,0 +1,81 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native high-level C interface to LAPACK function chetrf_rk +* Author: Intel Corporation +* Generated November 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_chetrf_rk( int matrix_layout, char uplo, lapack_int n, + lapack_complex_float* a, lapack_int lda, + lapack_complex_float* e, lapack_int* ipiv ) +{ + lapack_int info = 0; + lapack_int lwork = -1; + lapack_complex_float* work = NULL; + lapack_complex_float work_query; + if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { + LAPACKE_xerbla( "LAPACKE_chetrf_rk", -1 ); + return -1; + } +#ifndef LAPACK_DISABLE_NAN_CHECK + /* Optionally check input matrices for NaNs */ + if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) { + return -4; + } + if( LAPACKE_c_nancheck( n, e, 1 ) ) { + return -6; + } +#endif + /* Query optimal working array(s) size */ + info = LAPACKE_chetrf_rk_work( matrix_layout, uplo, n, a, lda, e, ipiv, + &work_query, lwork ); + if( info != 0 ) { + goto exit_level_0; + } + lwork = LAPACK_C2INT( work_query ); + /* Allocate memory for work arrays */ + work = (lapack_complex_float*) + LAPACKE_malloc( sizeof(lapack_complex_float) * lwork ); + if( work == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_0; + } + /* Call middle-level interface */ + info = LAPACKE_chetrf_rk_work( matrix_layout, uplo, n, a, lda, e, ipiv, work, + lwork ); + /* Release memory and exit */ + LAPACKE_free( work ); +exit_level_0: + if( info == LAPACK_WORK_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_chetrf_rk", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_chetrf_rk_work.c b/LAPACKE/src/lapacke_chetrf_rk_work.c new file mode 100644 index 00000000..1b0beb2e --- /dev/null +++ b/LAPACKE/src/lapacke_chetrf_rk_work.c @@ -0,0 +1,90 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native middle-level C interface to LAPACK function chetrf_rk +* Author: Intel Corporation +* Generated November 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_chetrf_rk_work( int matrix_layout, char uplo, lapack_int n, + lapack_complex_float* a, lapack_int lda, + lapack_complex_float* e, + lapack_int* ipiv, lapack_complex_float* work, + lapack_int lwork ) +{ + lapack_int info = 0; + if( matrix_layout == LAPACK_COL_MAJOR ) { + /* Call LAPACK function and adjust info */ + LAPACK_chetrf_rk( &uplo, &n, a, &lda, e, ipiv, work, &lwork, &info ); + if( info < 0 ) { + info = info - 1; + } + } else if( matrix_layout == LAPACK_ROW_MAJOR ) { + lapack_int lda_t = MAX(1,n); + lapack_complex_float* a_t = NULL; + /* Check leading dimension(s) */ + if( lda < n ) { + info = -5; + LAPACKE_xerbla( "LAPACKE_chetrf_rk_work", info ); + return info; + } + /* Query optimal working array(s) size if requested */ + if( lwork == -1 ) { + LAPACK_chetrf_rk( &uplo, &n, a, &lda_t, e, ipiv, work, &lwork, &info ); + return (info < 0) ? (info - 1) : 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; + } + /* Transpose input matrices */ + LAPACKE_che_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + /* Call LAPACK function and adjust info */ + LAPACK_chetrf_rk( &uplo, &n, a_t, &lda_t, e, ipiv, work, &lwork, &info ); + if( info < 0 ) { + info = info - 1; + } + /* Transpose output matrices */ + LAPACKE_che_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + /* Release memory and exit */ + LAPACKE_free( a_t ); +exit_level_0: + if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_chetrf_rk_work", info ); + } + } else { + info = -1; + LAPACKE_xerbla( "LAPACKE_chetrf_rk_work", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_chetri_3.c b/LAPACKE/src/lapacke_chetri_3.c new file mode 100644 index 00000000..eb0615c7 --- /dev/null +++ b/LAPACKE/src/lapacke_chetri_3.c @@ -0,0 +1,80 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native high-level C interface to LAPACK function chetri_3 +* Author: Intel Corporation +* Generated November 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_chetri_3( int matrix_layout, char uplo, lapack_int n, + lapack_complex_float* a, lapack_int lda, + const lapack_complex_float* e, const lapack_int* ipiv ) +{ + lapack_int info = 0; + lapack_int lwork = -1; + lapack_complex_float* work = NULL; + lapack_complex_float work_query; + if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { + LAPACKE_xerbla( "LAPACKE_chetri_3", -1 ); + return -1; + } +#ifndef LAPACK_DISABLE_NAN_CHECK + /* Optionally check input matrices for NaNs */ + if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) { + return -4; + } + if( LAPACKE_c_nancheck( n, e, 1 ) ) { + return -6; + } +#endif + /* Query optimal working array(s) size */ + info = LAPACKE_chetri_3_work( matrix_layout, uplo, n, a, lda, e, ipiv, + &work_query, lwork ); + if( info != 0 ) { + goto exit_level_0; + } + lwork = (lapack_int)work_query; + /* Allocate memory for working array(s) */ + work = (lapack_complex_float*) + LAPACKE_malloc( sizeof(lapack_complex_float) * lwork ); + if( work == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_0; + } + /* Call middle-level interface */ + info = LAPACKE_chetri_3_work( matrix_layout, uplo, n, a, lda, e, ipiv, work, lwork ); + /* Release memory and exit */ + LAPACKE_free( work ); +exit_level_0: + if( info == LAPACK_WORK_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_chetri_3", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_chetri_3_work.c b/LAPACKE/src/lapacke_chetri_3_work.c new file mode 100644 index 00000000..3f8f808d --- /dev/null +++ b/LAPACKE/src/lapacke_chetri_3_work.c @@ -0,0 +1,89 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native middle-level C interface to LAPACK function chetri_3 +* Author: Intel Corporation +* Generated November 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_chetri_3_work( int matrix_layout, char uplo, lapack_int n, + lapack_complex_float* a, lapack_int lda, + const lapack_complex_float* e, const lapack_int* ipiv, + lapack_complex_float* work, lapack_int lwork) +{ + lapack_int info = 0; + if( matrix_layout == LAPACK_COL_MAJOR ) { + /* Call LAPACK function and adjust info */ + LAPACK_chetri_3( &uplo, &n, a, &lda, e, ipiv, work, &lwork, &info ); + if( info < 0 ) { + info = info - 1; + } + } else if( matrix_layout == LAPACK_ROW_MAJOR ) { + lapack_int lda_t = MAX(1,n); + lapack_complex_float* a_t = NULL; + /* Check leading dimension(s) */ + if( lda < n ) { + info = -5; + LAPACKE_xerbla( "LAPACKE_chetri_3_work", info ); + return info; + } + /* Query optimal working array(s) size if requested */ + if( lwork == -1 ) { + LAPACK_chetri_3( &uplo, &n, a_t, &lda_t, e, ipiv, work, &lwork, &info ); + return (info < 0) ? (info - 1) : 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; + } + /* Transpose input matrices */ + LAPACKE_che_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + /* Call LAPACK function and adjust info */ + LAPACK_chetri_3( &uplo, &n, a_t, &lda_t, e, ipiv, work, &lwork, &info ); + if( info < 0 ) { + info = info - 1; + } + /* Transpose output matrices */ + LAPACKE_che_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + /* Release memory and exit */ + LAPACKE_free( a_t ); +exit_level_0: + if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_chetri_3_work", info ); + } + } else { + info = -1; + LAPACKE_xerbla( "LAPACKE_chetri_3_work", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_chetrs_3.c b/LAPACKE/src/lapacke_chetrs_3.c new file mode 100644 index 00000000..afe5ce0f --- /dev/null +++ b/LAPACKE/src/lapacke_chetrs_3.c @@ -0,0 +1,60 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native high-level C interface to LAPACK function chetrs_3 +* Author: Intel Corporation +* Generated November 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_chetrs_3( int matrix_layout, char uplo, lapack_int n, + lapack_int nrhs, const lapack_complex_float* a, + lapack_int lda, const lapack_complex_float* e, + const lapack_int* ipiv, + lapack_complex_float* b, lapack_int ldb ) +{ + if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { + LAPACKE_xerbla( "LAPACKE_chetrs_3", -1 ); + return -1; + } +#ifndef LAPACK_DISABLE_NAN_CHECK + /* Optionally check input matrices for NaNs */ + if( LAPACKE_che_nancheck( matrix_layout, uplo, n, a, lda ) ) { + return -5; + } + if( LAPACKE_c_nancheck( n, e ,1 ) ) { + return -7; + } + if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + return -9; + } +#endif + return LAPACKE_chetrs_3_work( matrix_layout, uplo, n, nrhs, a, lda, + e, ipiv, b, ldb ); +} diff --git a/LAPACKE/src/lapacke_chetrs_3_work.c b/LAPACKE/src/lapacke_chetrs_3_work.c new file mode 100644 index 00000000..8899a170 --- /dev/null +++ b/LAPACKE/src/lapacke_chetrs_3_work.c @@ -0,0 +1,103 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native middle-level C interface to LAPACK function chetrs_3 +* Author: Intel Corporation +* Generated November 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_chetrs_3_work( int matrix_layout, char uplo, lapack_int n, + lapack_int nrhs, const lapack_complex_float* a, + lapack_int lda, const lapack_complex_float* e, + const lapack_int* ipiv, + lapack_complex_float* b, lapack_int ldb ) +{ + lapack_int info = 0; + if( matrix_layout == LAPACK_COL_MAJOR ) { + /* Call LAPACK function and adjust info */ + LAPACK_chetrs_3( &uplo, &n, &nrhs, a, &lda, e, ipiv, b, &ldb, &info ); + if( info < 0 ) { + info = info - 1; + } + } else if( matrix_layout == LAPACK_ROW_MAJOR ) { + lapack_int lda_t = MAX(1,n); + lapack_int ldb_t = MAX(1,n); + lapack_complex_float* a_t = NULL; + lapack_complex_float* b_t = NULL; + /* Check leading dimension(s) */ + if( lda < n ) { + info = -6; + LAPACKE_xerbla( "LAPACKE_chetrs_3_work", info ); + return info; + } + if( ldb < nrhs ) { + info = -10; + LAPACKE_xerbla( "LAPACKE_chetrs_3_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; + } + b_t = (lapack_complex_float*) + LAPACKE_malloc( sizeof(lapack_complex_float) * + ldb_t * MAX(1,nrhs) ); + if( b_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_1; + } + /* Transpose input matrices */ + LAPACKE_che_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + /* Call LAPACK function and adjust info */ + LAPACK_chetrs_3( &uplo, &n, &nrhs, a_t, &lda_t, e, ipiv, b_t, &ldb_t, + &info ); + if( info < 0 ) { + info = info - 1; + } + /* Transpose output matrices */ + LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + /* Release memory and exit */ + LAPACKE_free( b_t ); +exit_level_1: + LAPACKE_free( a_t ); +exit_level_0: + if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_chetrs_3_work", info ); + } + } else { + info = -1; + LAPACKE_xerbla( "LAPACKE_chetrs_3_work", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_csycon_3.c b/LAPACKE/src/lapacke_csycon_3.c new file mode 100644 index 00000000..240184ab --- /dev/null +++ b/LAPACKE/src/lapacke_csycon_3.c @@ -0,0 +1,76 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native high-level C interface to LAPACK function csycon_3 +* Author: Intel Corporation +* Generated November 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_csycon_3( int matrix_layout, char uplo, lapack_int n, + const lapack_complex_float* a, lapack_int lda, + const lapack_complex_float* e, + const lapack_int* ipiv, float anorm, float* rcond ) +{ + lapack_int info = 0; + lapack_complex_float* work = NULL; + if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { + LAPACKE_xerbla( "LAPACKE_csycon_3", -1 ); + return -1; + } +#ifndef LAPACK_DISABLE_NAN_CHECK + /* Optionally check input matrices for NaNs */ + if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + return -4; + } + if( LAPACKE_c_nancheck( n, e, 1 ) ) { + return -6; + } + if( LAPACKE_s_nancheck( 1, &anorm, 1 ) ) { + return -8; + } +#endif + /* Allocate memory for working array(s) */ + work = (lapack_complex_float*) + LAPACKE_malloc( sizeof(lapack_complex_float) * MAX(1,2*n) ); + if( work == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_0; + } + /* Call middle-level interface */ + info = LAPACKE_csycon_3_work( matrix_layout, uplo, n, a, lda, e, ipiv, anorm, + rcond, work ); + /* Release memory and exit */ + LAPACKE_free( work ); +exit_level_0: + if( info == LAPACK_WORK_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_csycon_3", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_csycon_3_work.c b/LAPACKE/src/lapacke_csycon_3_work.c new file mode 100644 index 00000000..27ffc1e0 --- /dev/null +++ b/LAPACKE/src/lapacke_csycon_3_work.c @@ -0,0 +1,84 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native middle-level C interface to LAPACK function csycon_3 +* Author: Intel Corporation +* Generated November 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_csycon_3_work( int matrix_layout, char uplo, lapack_int n, + const lapack_complex_float* a, lapack_int lda, + const lapack_complex_float* e, + const lapack_int* ipiv, float anorm, + float* rcond, lapack_complex_float* work ) +{ + lapack_int info = 0; + if( matrix_layout == LAPACK_COL_MAJOR ) { + /* Call LAPACK function and adjust info */ + LAPACK_csycon_3( &uplo, &n, a, &lda, e, ipiv, &anorm, rcond, work, &info ); + if( info < 0 ) { + info = info - 1; + } + } else if( matrix_layout == LAPACK_ROW_MAJOR ) { + lapack_int lda_t = MAX(1,n); + lapack_complex_float* a_t = NULL; + /* Check leading dimension(s) */ + if( lda < n ) { + info = -5; + LAPACKE_xerbla( "LAPACKE_csycon_3_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; + } + /* Transpose input matrices */ + LAPACKE_csy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + /* Call LAPACK function and adjust info */ + LAPACK_csycon_3( &uplo, &n, a_t, &lda_t, e, ipiv, &anorm, rcond, work, + &info ); + if( info < 0 ) { + info = info - 1; + } + /* Release memory and exit */ + LAPACKE_free( a_t ); +exit_level_0: + if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_csycon_3_work", info ); + } + } else { + info = -1; + LAPACKE_xerbla( "LAPACKE_csycon_3_work", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_csysv_rk.c b/LAPACKE/src/lapacke_csysv_rk.c new file mode 100644 index 00000000..66b5b3e1 --- /dev/null +++ b/LAPACKE/src/lapacke_csysv_rk.c @@ -0,0 +1,86 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native high-level C interface to LAPACK function csysv_rk +* Author: Intel Corporation +* Generated November 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_csysv_rk( int matrix_layout, char uplo, lapack_int n, + lapack_int nrhs, lapack_complex_float* a, + lapack_int lda, lapack_complex_float* e, + lapack_int* ipiv, + lapack_complex_float* b, lapack_int ldb ) +{ + lapack_int info = 0; + lapack_int lwork = -1; + lapack_complex_float* work = NULL; + lapack_complex_float work_query; + if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { + LAPACKE_xerbla( "LAPACKE_csysv_rk", -1 ); + return -1; + } +#ifndef LAPACK_DISABLE_NAN_CHECK + /* Optionally check input matrices for NaNs */ + if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + return -5; + } + if( LAPACKE_c_nancheck( n, e, 1) ) { + return -7; + } + if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + return -9; + } +#endif + /* Query optimal working array(s) size */ + info = LAPACKE_csysv_rk_work( matrix_layout, uplo, n, nrhs, a, lda, e, ipiv, b, + ldb, &work_query, lwork ); + if( info != 0 ) { + goto exit_level_0; + } + lwork = LAPACK_C2INT( work_query ); + /* Allocate memory for work arrays */ + work = (lapack_complex_float*) + LAPACKE_malloc( sizeof(lapack_complex_float) * lwork ); + if( work == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_0; + } + /* Call middle-level interface */ + info = LAPACKE_csysv_rk_work( matrix_layout, uplo, n, nrhs, a, lda, e, ipiv, b, + ldb, work, lwork ); + /* Release memory and exit */ + LAPACKE_free( work ); +exit_level_0: + if( info == LAPACK_WORK_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_csysv_rk", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_csysv_rk_work.c b/LAPACKE/src/lapacke_csysv_rk_work.c new file mode 100644 index 00000000..90335688 --- /dev/null +++ b/LAPACKE/src/lapacke_csysv_rk_work.c @@ -0,0 +1,112 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native middle-level C interface to LAPACK function csysv_rk +* Author: Intel Corporation +* Generated November 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_csysv_rk_work( int matrix_layout, char uplo, lapack_int n, + lapack_int nrhs, lapack_complex_float* a, + lapack_int lda, lapack_complex_float* e, + lapack_int* ipiv, + lapack_complex_float* b, lapack_int ldb, + lapack_complex_float* work, lapack_int lwork ) +{ + lapack_int info = 0; + if( matrix_layout == LAPACK_COL_MAJOR ) { + /* Call LAPACK function and adjust info */ + LAPACK_csysv_rk( &uplo, &n, &nrhs, a, &lda, e, ipiv, b, &ldb, work, &lwork, + &info ); + if( info < 0 ) { + info = info - 1; + } + } else if( matrix_layout == LAPACK_ROW_MAJOR ) { + lapack_int lda_t = MAX(1,n); + lapack_int ldb_t = MAX(1,n); + lapack_complex_float* a_t = NULL; + lapack_complex_float* b_t = NULL; + /* Check leading dimension(s) */ + if( lda < n ) { + info = -6; + LAPACKE_xerbla( "LAPACKE_csysv_rk_work", info ); + return info; + } + if( ldb < nrhs ) { + info = -10; + LAPACKE_xerbla( "LAPACKE_csysv_rk_work", info ); + return info; + } + /* Query optimal working array(s) size if requested */ + if( lwork == -1 ) { + LAPACK_csysv_rk( &uplo, &n, &nrhs, a, &lda_t, e, ipiv, b, &ldb_t, work, + &lwork, &info ); + return (info < 0) ? (info - 1) : 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; + } + b_t = (lapack_complex_float*) + LAPACKE_malloc( sizeof(lapack_complex_float) * + ldb_t * MAX(1,nrhs) ); + if( b_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_1; + } + /* Transpose input matrices */ + LAPACKE_csy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + /* Call LAPACK function and adjust info */ + LAPACK_csysv_rk( &uplo, &n, &nrhs, a_t, &lda_t, e, ipiv, b_t, &ldb_t, work, + &lwork, &info ); + if( info < 0 ) { + info = info - 1; + } + /* Transpose output matrices */ + LAPACKE_csy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + /* Release memory and exit */ + LAPACKE_free( b_t ); +exit_level_1: + LAPACKE_free( a_t ); +exit_level_0: + if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_csysv_rk_work", info ); + } + } else { + info = -1; + LAPACKE_xerbla( "LAPACKE_csysv_rk_work", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_csytrf_rk.c b/LAPACKE/src/lapacke_csytrf_rk.c new file mode 100644 index 00000000..fd0b6091 --- /dev/null +++ b/LAPACKE/src/lapacke_csytrf_rk.c @@ -0,0 +1,81 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native high-level C interface to LAPACK function csytrf_rk +* Author: Intel Corporation +* Generated November 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_csytrf_rk( int matrix_layout, char uplo, lapack_int n, + lapack_complex_float* a, lapack_int lda, + lapack_complex_float* e, lapack_int* ipiv ) +{ + lapack_int info = 0; + lapack_int lwork = -1; + lapack_complex_float* work = NULL; + lapack_complex_float work_query; + if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { + LAPACKE_xerbla( "LAPACKE_csytrf_rk", -1 ); + return -1; + } +#ifndef LAPACK_DISABLE_NAN_CHECK + /* Optionally check input matrices for NaNs */ + if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + return -4; + } + if( LAPACKE_c_nancheck( n, e, 1 ) ) { + return -6; + } +#endif + /* Query optimal working array(s) size */ + info = LAPACKE_csytrf_rk_work( matrix_layout, uplo, n, a, lda, e, ipiv, + &work_query, lwork ); + if( info != 0 ) { + goto exit_level_0; + } + lwork = LAPACK_C2INT( work_query ); + /* Allocate memory for work arrays */ + work = (lapack_complex_float*) + LAPACKE_malloc( sizeof(lapack_complex_float) * lwork ); + if( work == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_0; + } + /* Call middle-level interface */ + info = LAPACKE_csytrf_rk_work( matrix_layout, uplo, n, a, lda, e, ipiv, work, + lwork ); + /* Release memory and exit */ + LAPACKE_free( work ); +exit_level_0: + if( info == LAPACK_WORK_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_csytrf_rk", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_csytrf_rk_work.c b/LAPACKE/src/lapacke_csytrf_rk_work.c new file mode 100644 index 00000000..6f44634f --- /dev/null +++ b/LAPACKE/src/lapacke_csytrf_rk_work.c @@ -0,0 +1,90 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native middle-level C interface to LAPACK function csytrf_rk +* Author: Intel Corporation +* Generated November 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_csytrf_rk_work( int matrix_layout, char uplo, lapack_int n, + lapack_complex_float* a, lapack_int lda, + lapack_complex_float* e, + lapack_int* ipiv, lapack_complex_float* work, + lapack_int lwork ) +{ + lapack_int info = 0; + if( matrix_layout == LAPACK_COL_MAJOR ) { + /* Call LAPACK function and adjust info */ + LAPACK_csytrf_rk( &uplo, &n, a, &lda, e, ipiv, work, &lwork, &info ); + if( info < 0 ) { + info = info - 1; + } + } else if( matrix_layout == LAPACK_ROW_MAJOR ) { + lapack_int lda_t = MAX(1,n); + lapack_complex_float* a_t = NULL; + /* Check leading dimension(s) */ + if( lda < n ) { + info = -5; + LAPACKE_xerbla( "LAPACKE_csytrf_rk_work", info ); + return info; + } + /* Query optimal working array(s) size if requested */ + if( lwork == -1 ) { + LAPACK_csytrf_rk( &uplo, &n, a, &lda_t, e, ipiv, work, &lwork, &info ); + return (info < 0) ? (info - 1) : 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; + } + /* Transpose input matrices */ + LAPACKE_csy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + /* Call LAPACK function and adjust info */ + LAPACK_csytrf_rk( &uplo, &n, a_t, &lda_t, e, ipiv, work, &lwork, &info ); + if( info < 0 ) { + info = info - 1; + } + /* Transpose output matrices */ + LAPACKE_csy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + /* Release memory and exit */ + LAPACKE_free( a_t ); +exit_level_0: + if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_csytrf_rk_work", info ); + } + } else { + info = -1; + LAPACKE_xerbla( "LAPACKE_csytrf_rk_work", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_csytri_3.c b/LAPACKE/src/lapacke_csytri_3.c new file mode 100644 index 00000000..2eb94d84 --- /dev/null +++ b/LAPACKE/src/lapacke_csytri_3.c @@ -0,0 +1,80 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native high-level C interface to LAPACK function csytri_3 +* Author: Intel Corporation +* Generated November 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_csytri_3( int matrix_layout, char uplo, lapack_int n, + lapack_complex_float* a, lapack_int lda, + const lapack_complex_float* e, const lapack_int* ipiv ) +{ + lapack_int info = 0; + lapack_int lwork = -1; + lapack_complex_float* work = NULL; + lapack_complex_float work_query; + if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { + LAPACKE_xerbla( "LAPACKE_csytri_3", -1 ); + return -1; + } +#ifndef LAPACK_DISABLE_NAN_CHECK + /* Optionally check input matrices for NaNs */ + if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + return -4; + } + if( LAPACKE_c_nancheck( n, e, 1 ) ) { + return -6; + } +#endif + /* Query optimal working array(s) size */ + info = LAPACKE_csytri_3_work( matrix_layout, uplo, n, a, lda, e, ipiv, + &work_query, lwork ); + if( info != 0 ) { + goto exit_level_0; + } + lwork = (lapack_int)work_query; + /* Allocate memory for working array(s) */ + work = (lapack_complex_float*) + LAPACKE_malloc( sizeof(lapack_complex_float) * lwork ); + if( work == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_0; + } + /* Call middle-level interface */ + info = LAPACKE_csytri_3_work( matrix_layout, uplo, n, a, lda, e, ipiv, work, lwork ); + /* Release memory and exit */ + LAPACKE_free( work ); +exit_level_0: + if( info == LAPACK_WORK_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_csytri_3", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_csytri_3_work.c b/LAPACKE/src/lapacke_csytri_3_work.c new file mode 100644 index 00000000..8845c595 --- /dev/null +++ b/LAPACKE/src/lapacke_csytri_3_work.c @@ -0,0 +1,89 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native middle-level C interface to LAPACK function csytri_3 +* Author: Intel Corporation +* Generated November 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_csytri_3_work( int matrix_layout, char uplo, lapack_int n, + lapack_complex_float* a, lapack_int lda, + const lapack_complex_float* e, const lapack_int* ipiv, + lapack_complex_float* work, lapack_int lwork) +{ + lapack_int info = 0; + if( matrix_layout == LAPACK_COL_MAJOR ) { + /* Call LAPACK function and adjust info */ + LAPACK_csytri_3( &uplo, &n, a, &lda, e, ipiv, work, &lwork, &info ); + if( info < 0 ) { + info = info - 1; + } + } else if( matrix_layout == LAPACK_ROW_MAJOR ) { + lapack_int lda_t = MAX(1,n); + lapack_complex_float* a_t = NULL; + /* Check leading dimension(s) */ + if( lda < n ) { + info = -5; + LAPACKE_xerbla( "LAPACKE_csytri_3_work", info ); + return info; + } + /* Query optimal working array(s) size if requested */ + if( lwork == -1 ) { + LAPACK_csytri_3( &uplo, &n, a_t, &lda_t, e, ipiv, work, &lwork, &info ); + return (info < 0) ? (info - 1) : 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; + } + /* Transpose input matrices */ + LAPACKE_csy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + /* Call LAPACK function and adjust info */ + LAPACK_csytri_3( &uplo, &n, a_t, &lda_t, e, ipiv, work, &lwork, &info ); + if( info < 0 ) { + info = info - 1; + } + /* Transpose output matrices */ + LAPACKE_csy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + /* Release memory and exit */ + LAPACKE_free( a_t ); +exit_level_0: + if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_csytri_3_work", info ); + } + } else { + info = -1; + LAPACKE_xerbla( "LAPACKE_csytri_3_work", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_csytrs_3.c b/LAPACKE/src/lapacke_csytrs_3.c new file mode 100644 index 00000000..7433e287 --- /dev/null +++ b/LAPACKE/src/lapacke_csytrs_3.c @@ -0,0 +1,60 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native high-level C interface to LAPACK function csytrs_3 +* Author: Intel Corporation +* Generated November 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_csytrs_3( int matrix_layout, char uplo, lapack_int n, + lapack_int nrhs, const lapack_complex_float* a, + lapack_int lda, const lapack_complex_float* e, + const lapack_int* ipiv, + lapack_complex_float* b, lapack_int ldb ) +{ + if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { + LAPACKE_xerbla( "LAPACKE_csytrs_3", -1 ); + return -1; + } +#ifndef LAPACK_DISABLE_NAN_CHECK + /* Optionally check input matrices for NaNs */ + if( LAPACKE_csy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + return -5; + } + if( LAPACKE_c_nancheck( n, e ,1 ) ) { + return -7; + } + if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + return -9; + } +#endif + return LAPACKE_csytrs_3_work( matrix_layout, uplo, n, nrhs, a, lda, + e, ipiv, b, ldb ); +} diff --git a/LAPACKE/src/lapacke_csytrs_3_work.c b/LAPACKE/src/lapacke_csytrs_3_work.c new file mode 100644 index 00000000..0015eaa1 --- /dev/null +++ b/LAPACKE/src/lapacke_csytrs_3_work.c @@ -0,0 +1,103 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native middle-level C interface to LAPACK function csytrs_3 +* Author: Intel Corporation +* Generated November 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_csytrs_3_work( int matrix_layout, char uplo, lapack_int n, + lapack_int nrhs, const lapack_complex_float* a, + lapack_int lda, const lapack_complex_float* e, + const lapack_int* ipiv, + lapack_complex_float* b, lapack_int ldb ) +{ + lapack_int info = 0; + if( matrix_layout == LAPACK_COL_MAJOR ) { + /* Call LAPACK function and adjust info */ + LAPACK_csytrs_3( &uplo, &n, &nrhs, a, &lda, e, ipiv, b, &ldb, &info ); + if( info < 0 ) { + info = info - 1; + } + } else if( matrix_layout == LAPACK_ROW_MAJOR ) { + lapack_int lda_t = MAX(1,n); + lapack_int ldb_t = MAX(1,n); + lapack_complex_float* a_t = NULL; + lapack_complex_float* b_t = NULL; + /* Check leading dimension(s) */ + if( lda < n ) { + info = -6; + LAPACKE_xerbla( "LAPACKE_csytrs_3_work", info ); + return info; + } + if( ldb < nrhs ) { + info = -10; + LAPACKE_xerbla( "LAPACKE_csytrs_3_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; + } + b_t = (lapack_complex_float*) + LAPACKE_malloc( sizeof(lapack_complex_float) * + ldb_t * MAX(1,nrhs) ); + if( b_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_1; + } + /* Transpose input matrices */ + LAPACKE_csy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + /* Call LAPACK function and adjust info */ + LAPACK_csytrs_3( &uplo, &n, &nrhs, a_t, &lda_t, e, ipiv, b_t, &ldb_t, + &info ); + if( info < 0 ) { + info = info - 1; + } + /* Transpose output matrices */ + LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + /* Release memory and exit */ + LAPACKE_free( b_t ); +exit_level_1: + LAPACKE_free( a_t ); +exit_level_0: + if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_csytrs_3_work", info ); + } + } else { + info = -1; + LAPACKE_xerbla( "LAPACKE_csytrs_3_work", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_dgelq.c b/LAPACKE/src/lapacke_dgelq.c new file mode 100644 index 00000000..80b8dd90 --- /dev/null +++ b/LAPACKE/src/lapacke_dgelq.c @@ -0,0 +1,79 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native high-level C interface to LAPACK function dgelq +* Author: Intel Corporation +* Generated November 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_dgelq_work( int matrix_layout, lapack_int m, lapack_int n, + double* a, lapack_int lda, + double* t, lapack_int tsize ) +{ + lapack_int info = 0; + lapack_int lwork = -1; + double* work = NULL; + double work_query; + if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { + LAPACKE_xerbla( "LAPACKE_dgelq", -1 ); + return -1; + } +#ifndef LAPACK_DISABLE_NAN_CHECK + /* Optionally check input matrices for NaNs */ + if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) { + return -4; + } +#endif + /* Query optimal working array(s) size */ + info = LAPACKE_dgelq_work( matrix_layout, m, n, a, lda, t, tsize, &work_query, + lwork ); + if( info != 0 ) { + goto exit_level_0; + } + if( tsize == -1 || tsize == -2 ) { + goto exit_level_0; + } + lwork = (lapack_int)work_query; + /* Allocate memory for work arrays */ + work = (double*)LAPACKE_malloc( sizeof(double) * lwork ); + if( work == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_0; + } + /* Call middle-level interface */ + info = LAPACKE_dgelq_work( matrix_layout, m, n, a, lda, t, tsize, work, lwork ); + /* Release memory and exit */ + LAPACKE_free( work ); +exit_level_0: + if( info == LAPACK_WORK_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_dgelq", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_dgelq_work.c b/LAPACKE/src/lapacke_dgelq_work.c new file mode 100644 index 00000000..e5a1dfa4 --- /dev/null +++ b/LAPACKE/src/lapacke_dgelq_work.c @@ -0,0 +1,88 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native middle-level C interface to LAPACK function dgelq +* Author: Intel Corporation +* Generated November 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_dgelq_work( int matrix_layout, lapack_int m, lapack_int n, + double* a, lapack_int lda, + double* t, lapack_int tsize, + double* work, lapack_int lwork ) +{ + lapack_int info = 0; + if( matrix_layout == LAPACK_COL_MAJOR ) { + /* Call LAPACK function and adjust info */ + LAPACK_dgelq( &m, &n, a, &lda, t, &tsize, work, &lwork, &info ); + if( info < 0 ) { + info = info - 1; + } + } else if( matrix_layout == LAPACK_ROW_MAJOR ) { + lapack_int lda_t = MAX(1,m); + double* a_t = NULL; + /* Check leading dimension(s) */ + if( lda < n ) { + info = -5; + LAPACKE_xerbla( "LAPACKE_dgelq_work", info ); + return info; + } + /* Query optimal working array(s) size if requested */ + if( tsize == -1 || tsize == -2 || lwork == -1 || lwork == -2) { + LAPACK_dgelq( &m, &n, a, &lda_t, t, &tsize, work, &lwork, &info ); + return (info < 0) ? (info - 1) : 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; + } + /* Transpose input matrices */ + LAPACKE_dge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + /* Call LAPACK function and adjust info */ + LAPACK_dgelq( &m, &n, a_t, &lda_t, t, &tsize, work, &lwork, &info ); + if( info < 0 ) { + info = info - 1; + } + /* Transpose output matrices */ + LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + /* Release memory and exit */ + LAPACKE_free( a_t ); +exit_level_0: + if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_dgelq_work", info ); + } + } else { + info = -1; + LAPACKE_xerbla( "LAPACKE_dgelq_work", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_dgemlq.c b/LAPACKE/src/lapacke_dgemlq.c new file mode 100644 index 00000000..5fa6e0ec --- /dev/null +++ b/LAPACKE/src/lapacke_dgemlq.c @@ -0,0 +1,85 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native high-level C interface to LAPACK function dgemlq +* Author: Intel Corporation +* Generated November 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_dgemlq( int matrix_layout, char side, char trans, + lapack_int m, lapack_int n, lapack_int k, + const double* a, lapack_int lda, + const double* t, lapack_int tsize, + double* c, lapack_int ldc ) +{ + lapack_int info = 0; + lapack_int lwork = -1; + double* work = NULL; + double work_query; + if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { + LAPACKE_xerbla( "LAPACKE_dgemlq", -1 ); + return -1; + } +#ifndef LAPACK_DISABLE_NAN_CHECK + /* Optionally check input matrices for NaNs */ + if( LAPACKE_dge_nancheck( matrix_layout, k, m, a, lda ) ) { + return -7; + } + if( LAPACKE_dge_nancheck( matrix_layout, m, n, c, ldc ) ) { + return -10; + } + if( LAPACKE_d_nancheck( tsize, t, 1 ) ) { + return -9; + } +#endif + /* Query optimal working array(s) size */ + info = LAPACKE_dgemlq_work( matrix_layout, side, trans, m, n, k, a, lda, + t, tsize, c, ldc, &work_query, lwork ); + if( info != 0 ) { + goto exit_level_0; + } + lwork = (lapack_int)work_query; + /* Allocate memory for work arrays */ + work = (double*)LAPACKE_malloc( sizeof(double) * lwork ); + if( work == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_0; + } + /* Call middle-level interface */ + info = LAPACKE_dgemlq_work( matrix_layout, side, trans, m, n, k, a, lda, + t, tsize, c, ldc, work, lwork ); + /* Release memory and exit */ + LAPACKE_free( work ); +exit_level_0: + if( info == LAPACK_WORK_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_dgemlq", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_dgemlq_work.c b/LAPACKE/src/lapacke_dgemlq_work.c new file mode 100644 index 00000000..e85252a1 --- /dev/null +++ b/LAPACKE/src/lapacke_dgemlq_work.c @@ -0,0 +1,114 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native middle-level C interface to LAPACK function dgemlq +* Author: Intel Corporation +* Generated June 2016 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_dgemlq_work( int matrix_layout, char side, char trans, + lapack_int m, lapack_int n, lapack_int k, + const double* a, lapack_int lda, + const double* t, lapack_int tsize, + double* c, lapack_int ldc, + double* work, lapack_int lwork ) +{ + lapack_int info = 0; + lapack_int r; + lapack_int lda_t, ldc_t; + double *a_t = NULL, *c_t = NULL; + if( matrix_layout == LAPACK_COL_MAJOR ) { + /* Call LAPACK function and adjust info */ + LAPACK_dgemlq( &side, &trans, &m, &n, &k, a, &lda, t, &tsize, + c, &ldc, work, &lwork, &info ); + if( info < 0 ) { + info = info - 1; + } + } else if( matrix_layout == LAPACK_ROW_MAJOR ) { + r = LAPACKE_lsame( side, 'l' ) ? m : n; + lda_t = MAX(1,k); + ldc_t = MAX(1,m); + /* Check leading dimension(s) */ + if( lda < r ) { + info = -8; + LAPACKE_xerbla( "LAPACKE_dgemlq_work", info ); + return info; + } + if( ldc < n ) { + info = -11; + LAPACKE_xerbla( "LAPACKE_dgemlq_work", info ); + return info; + } + /* Query optimal working array(s) size if requested */ + if( lwork == -1 ) { + LAPACK_dgemlq( &side, &trans, &m, &n, &k, a, &lda_t, t, &tsize, + c, &ldc_t, work, &lwork, &info ); + return (info < 0) ? (info - 1) : info; + } + /* Allocate memory for temporary array(s) */ + if( LAPACKE_lsame( side, 'l' ) ) { + a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,m) ); + } else { + 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; + } + c_t = (double*)LAPACKE_malloc( sizeof(double) * ldc_t * MAX(1,n) ); + if( c_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_1; + } + /* Transpose input matrices */ + LAPACKE_dge_trans( matrix_layout, k, m, a, lda, a_t, lda_t ); + LAPACKE_dge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t ); + /* Call LAPACK function and adjust info */ + LAPACK_dgemlq( &side, &trans, &m, &n, &k, a_t, &lda_t, t, &tsize, + c_t, &ldc_t, work, &lwork, &info ); + if( info < 0 ) { + info = info - 1; + } + /* Transpose output matrices */ + LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); + /* Release memory and exit */ + LAPACKE_free( c_t ); +exit_level_1: + LAPACKE_free( a_t ); +exit_level_0: + if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_dgemlq_work", info ); + } + } else { + info = -1; + LAPACKE_xerbla( "LAPACKE_dgemlq_work", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_dgemqr.c b/LAPACKE/src/lapacke_dgemqr.c new file mode 100644 index 00000000..86566d9c --- /dev/null +++ b/LAPACKE/src/lapacke_dgemqr.c @@ -0,0 +1,87 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native high-level C interface to LAPACK function dgemqr +* Author: Intel Corporation +* Generated December 2016 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_dgemqr( int matrix_layout, char side, char trans, + lapack_int m, lapack_int n, lapack_int k, + const double* a, lapack_int lda, + const double* t, lapack_int tsize, + double* c, lapack_int ldc ) +{ + lapack_int info = 0; + lapack_int lwork = -1; + double* work = NULL; + double work_query; + lapack_int r; + if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { + LAPACKE_xerbla( "LAPACKE_dgemqr", -1 ); + return -1; + } +#ifndef LAPACK_DISABLE_NAN_CHECK + /* Optionally check input matrices for NaNs */ + r = LAPACKE_lsame( side, 'l' ) ? m : n; + if( LAPACKE_dge_nancheck( matrix_layout, r, k, a, lda ) ) { + return -7; + } + if( LAPACKE_dge_nancheck( matrix_layout, m, n, c, ldc ) ) { + return -10; + } + if( LAPACKE_d_nancheck( tsize, t, 1 ) ) { + return -9; + } +#endif + /* Query optimal working array(s) size */ + info = LAPACKE_dgemqr_work( matrix_layout, side, trans, m, n, k, a, lda, + t, tsize, c, ldc, &work_query, lwork ); + if( info != 0 ) { + goto exit_level_0; + } + lwork = (lapack_int)work_query; + /* Allocate memory for work arrays */ + work = (double*)LAPACKE_malloc( sizeof(double) * lwork ); + if( work == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_0; + } + /* Call middle-level interface */ + info = LAPACKE_dgemqr_work( matrix_layout, side, trans, m, n, k, a, lda, + t, tsize, c, ldc, work, lwork ); + /* Release memory and exit */ + LAPACKE_free( work ); +exit_level_0: + if( info == LAPACK_WORK_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_dgemqr", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_dgemqr_work.c b/LAPACKE/src/lapacke_dgemqr_work.c new file mode 100644 index 00000000..a1179a46 --- /dev/null +++ b/LAPACKE/src/lapacke_dgemqr_work.c @@ -0,0 +1,112 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native middle-level C interface to LAPACK function dgemqr +* Author: Intel Corporation +* Generated December 2016 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_dgemqr_work( int matrix_layout, char side, char trans, + lapack_int m, lapack_int n, lapack_int k, + const double* a, lapack_int lda, + const double* t, lapack_int tsize, + double* c, lapack_int ldc, + double* work, lapack_int lwork ) +{ + lapack_int info = 0; + lapack_int r; + lapack_int lda_t, ldc_t; + double *a_t = NULL, *c_t = NULL; + if( matrix_layout == LAPACK_COL_MAJOR ) { + /* Call LAPACK function and adjust info */ + LAPACK_dgemqr( &side, &trans, &m, &n, &k, a, &lda, t, &tsize, c, &ldc, + work, &lwork, &info ); + if( info < 0 ) { + info = info - 1; + } + } else if( matrix_layout == LAPACK_ROW_MAJOR ) { + r = LAPACKE_lsame( side, 'l' ) ? m : n; + lda_t = MAX(1,r); + ldc_t = MAX(1,m); + /* Check leading dimension(s) */ + if( lda < k ) { + info = -8; + LAPACKE_xerbla( "LAPACKE_dgemqr_work", info ); + return info; + } + if( ldc < n ) { + info = -11; + LAPACKE_xerbla( "LAPACKE_dgemqr_work", info ); + return info; + } + /* Query optimal working array(s) size if requested */ + if( lwork == -1 ) { + LAPACK_dgemqr( &side, &trans, &m, &n, &k, a, &lda_t, t, &tsize, + c, &ldc_t, work, &lwork, &info ); + return (info < 0) ? (info - 1) : info; + } + /* Allocate memory for temporary array(s) */ + a_t = (double*) + LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,k) ); + if( a_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_0; + } + c_t = (double*) + LAPACKE_malloc( sizeof(double) * ldc_t * MAX(1,n) ); + if( c_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_1; + } + /* Transpose input matrices */ + LAPACKE_dge_trans( matrix_layout, r, k, a, lda, a_t, lda_t ); + LAPACKE_dge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t ); + /* Call LAPACK function and adjust info */ + LAPACK_dgemqr( &side, &trans, &m, &n, &k, a_t, &lda_t, t, &tsize, + c_t, &ldc_t, work, &lwork, &info ); + if( info < 0 ) { + info = info - 1; + } + /* Transpose output matrices */ + LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); + /* Release memory and exit */ + LAPACKE_free( c_t ); +exit_level_1: + LAPACKE_free( a_t ); +exit_level_0: + if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_dgemqr_work", info ); + } + } else { + info = -1; + LAPACKE_xerbla( "LAPACKE_dgemqr_work", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_dgeqr.c b/LAPACKE/src/lapacke_dgeqr.c new file mode 100644 index 00000000..7f9f9d29 --- /dev/null +++ b/LAPACKE/src/lapacke_dgeqr.c @@ -0,0 +1,79 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native high-level C interface to LAPACK function dgeqr +* Author: Intel Corporation +* Generated December 2016 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_dgeqr( int matrix_layout, lapack_int m, lapack_int n, + double* a, lapack_int lda, + double* t, lapack_int tsize ) +{ + lapack_int info = 0; + lapack_int lwork = -1; + double* work = NULL; + double work_query; + if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { + LAPACKE_xerbla( "LAPACKE_dgeqr", -1 ); + return -1; + } +#ifndef LAPACK_DISABLE_NAN_CHECK + /* Optionally check input matrices for NaNs */ + if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) { + return -4; + } +#endif + /* Query optimal working array(s) size */ + info = LAPACKE_dgeqr_work( matrix_layout, m, n, a, lda, t, tsize, &work_query, + lwork ); + if( info != 0 ) { + goto exit_level_0; + } + if( tsize == -1 || tsize == -2 ) { + goto exit_level_0; + } + lwork = (lapack_int)work_query; + /* Allocate memory for work arrays */ + work = (double*)LAPACKE_malloc( sizeof(double) * lwork ); + if( work == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_0; + } + /* Call middle-level interface */ + info = LAPACKE_dgeqr_work( matrix_layout, m, n, a, lda, t, tsize, work, lwork ); + /* Release memory and exit */ + LAPACKE_free( work ); +exit_level_0: + if( info == LAPACK_WORK_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_dgeqr", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_dgeqr_work.c b/LAPACKE/src/lapacke_dgeqr_work.c new file mode 100644 index 00000000..8bc3b1cb --- /dev/null +++ b/LAPACKE/src/lapacke_dgeqr_work.c @@ -0,0 +1,89 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native middle-level C interface to LAPACK function dgeqr +* Author: Intel Corporation +* Generated December 2016 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_dgeqr_work( int matrix_layout, lapack_int m, lapack_int n, + double* a, lapack_int lda, + double* t, lapack_int tsize, + double* work, lapack_int lwork ) +{ + lapack_int info = 0; + if( matrix_layout == LAPACK_COL_MAJOR ) { + /* Call LAPACK function and adjust info */ + LAPACK_dgeqr( &m, &n, a, &lda, t, &tsize, work, &lwork, &info ); + if( info < 0 ) { + info = info - 1; + } + } else if( matrix_layout == LAPACK_ROW_MAJOR ) { + lapack_int lda_t = MAX(1,m); + double* a_t = NULL; + /* Check leading dimension(s) */ + if( lda < n ) { + info = -5; + LAPACKE_xerbla( "LAPACKE_dgeqr_work", info ); + return info; + } + /* Query optimal working array(s) size if requested */ + if( tsize == -1 || tsize == -2 || lwork == -1 || lwork == -2) { + LAPACK_dgeqr( &m, &n, a, &lda_t, t, &tsize, work, &lwork, &info ); + return (info < 0) ? (info - 1) : 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; + } + /* Transpose input matrices */ + LAPACKE_dge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + /* Call LAPACK function and adjust info */ + LAPACK_dgeqr( &m, &n, a_t, &lda_t, t, &tsize, work, &lwork, &info ); + if( info < 0 ) { + info = info - 1; + } + /* Transpose output matrices */ + LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + /* Release memory and exit */ + LAPACKE_free( a_t ); +exit_level_0: + if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_dgeqr_work", info ); + } + } else { + info = -1; + LAPACKE_xerbla( "LAPACKE_dgeqr_work", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_dgetsls.c b/LAPACKE/src/lapacke_dgetsls.c new file mode 100644 index 00000000..57563f5e --- /dev/null +++ b/LAPACKE/src/lapacke_dgetsls.c @@ -0,0 +1,80 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native high-level C interface to LAPACK function dgetsls +* Author: Intel Corporation +* Generated December 2016 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_dgetsls( int matrix_layout, char trans, lapack_int m, + lapack_int n, lapack_int nrhs, double* a, + lapack_int lda, double* b, lapack_int ldb ) +{ + lapack_int info = 0; + lapack_int lwork = -1; + double* work = NULL; + double work_query; + if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { + LAPACKE_xerbla( "LAPACKE_dgetsls", -1 ); + return -1; + } +#ifndef LAPACK_DISABLE_NAN_CHECK + /* Optionally check input matrices for NaNs */ + if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) { + return -6; + } + if( LAPACKE_dge_nancheck( matrix_layout, MAX(m,n), nrhs, b, ldb ) ) { + return -8; + } +#endif + /* Query optimal working array(s) size */ + info = LAPACKE_dgetsls_work( matrix_layout, trans, m, n, nrhs, a, lda, b, ldb, + &work_query, lwork ); + if( info != 0 ) { + goto exit_level_0; + } + lwork = (lapack_int)work_query; + /* Allocate memory for work arrays */ + work = (double*)LAPACKE_malloc( sizeof(double) * lwork ); + if( work == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_0; + } + /* Call middle-level interface */ + info = LAPACKE_dgetsls_work( matrix_layout, trans, m, n, nrhs, a, lda, b, ldb, + work, lwork ); + /* Release memory and exit */ + LAPACKE_free( work ); +exit_level_0: + if( info == LAPACK_WORK_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_dgetsls", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_dgetsls_work.c b/LAPACKE/src/lapacke_dgetsls_work.c new file mode 100644 index 00000000..6f84d674 --- /dev/null +++ b/LAPACKE/src/lapacke_dgetsls_work.c @@ -0,0 +1,108 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native middle-level C interface to LAPACK function dgetsls +* Author: Intel Corporation +* Generated December 2016 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_dgetsls_work( int matrix_layout, char trans, lapack_int m, + lapack_int n, lapack_int nrhs, double* a, + lapack_int lda, double* b, lapack_int ldb, + double* work, lapack_int lwork ) +{ + lapack_int info = 0; + if( matrix_layout == LAPACK_COL_MAJOR ) { + /* Call LAPACK function and adjust info */ + LAPACK_dgetsls( &trans, &m, &n, &nrhs, a, &lda, b, &ldb, work, &lwork, + &info ); + if( info < 0 ) { + info = info - 1; + } + } else if( matrix_layout == LAPACK_ROW_MAJOR ) { + lapack_int lda_t = MAX(1,m); + lapack_int ldb_t = MAX(1,MAX(m,n)); + double* a_t = NULL; + double* b_t = NULL; + /* Check leading dimension(s) */ + if( lda < n ) { + info = -7; + LAPACKE_xerbla( "LAPACKE_dgetsls_work", info ); + return info; + } + if( ldb < nrhs ) { + info = -9; + LAPACKE_xerbla( "LAPACKE_dgetsls_work", info ); + return info; + } + /* Query optimal working array(s) size if requested */ + if( lwork == -1 ) { + LAPACK_dgetsls( &trans, &m, &n, &nrhs, a, &lda_t, b, &ldb_t, work, + &lwork, &info ); + return (info < 0) ? (info - 1) : 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; + } + b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,nrhs) ); + if( b_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 ); + LAPACKE_dge_trans( matrix_layout, MAX(m,n), nrhs, b, ldb, b_t, ldb_t ); + /* Call LAPACK function and adjust info */ + LAPACK_dgetsls( &trans, &m, &n, &nrhs, a_t, &lda_t, b_t, &ldb_t, work, + &lwork, &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, MAX(m,n), nrhs, b_t, ldb_t, b, + ldb ); + /* Release memory and exit */ + LAPACKE_free( b_t ); +exit_level_1: + LAPACKE_free( a_t ); +exit_level_0: + if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_dgetsls_work", info ); + } + } else { + info = -1; + LAPACKE_xerbla( "LAPACKE_dgetsls_work", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_dsycon_3.c b/LAPACKE/src/lapacke_dsycon_3.c new file mode 100644 index 00000000..c31d9756 --- /dev/null +++ b/LAPACKE/src/lapacke_dsycon_3.c @@ -0,0 +1,82 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native high-level C interface to LAPACK function dsycon_3 +* Author: Intel Corporation +* Generated November 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_dsycon_3( int matrix_layout, char uplo, lapack_int n, + const double* a, lapack_int lda, const double* e, + const lapack_int* ipiv, double anorm, double* rcond ) +{ + lapack_int info = 0; + lapack_int* iwork = NULL; + double* work = NULL; + if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { + LAPACKE_xerbla( "LAPACKE_dsycon_3", -1 ); + return -1; + } +#ifndef LAPACK_DISABLE_NAN_CHECK + /* Optionally check input matrices for NaNs */ + if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + return -4; + } + if( LAPACKE_d_nancheck( n, e, 1 ) ) { + return -6; + } + if( LAPACKE_d_nancheck( 1, &anorm, 1 ) ) { + return -8; + } +#endif + /* Allocate memory for working array(s) */ + iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n) ); + if( iwork == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_0; + } + work = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,2*n) ); + if( work == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_1; + } + /* Call middle-level interface */ + info = LAPACKE_dsycon_3_work( matrix_layout, uplo, n, a, lda, e, ipiv, anorm, + rcond, work, iwork ); + /* Release memory and exit */ + LAPACKE_free( work ); +exit_level_1: + LAPACKE_free( iwork ); +exit_level_0: + if( info == LAPACK_WORK_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_dsycon_3", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_dsycon_3_work.c b/LAPACKE/src/lapacke_dsycon_3_work.c new file mode 100644 index 00000000..4674c6f8 --- /dev/null +++ b/LAPACKE/src/lapacke_dsycon_3_work.c @@ -0,0 +1,83 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native middle-level C interface to LAPACK function dsycon_3 +* Author: Intel Corporation +* Generated November 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_dsycon_3_work( int matrix_layout, char uplo, lapack_int n, + const double* a, lapack_int lda, + const double* e, const lapack_int* ipiv, double anorm, + double* rcond, double* work, lapack_int* iwork ) +{ + lapack_int info = 0; + if( matrix_layout == LAPACK_COL_MAJOR ) { + /* Call LAPACK function and adjust info */ + LAPACK_dsycon_3( &uplo, &n, a, &lda, e, ipiv, &anorm, rcond, work, iwork, + &info ); + if( info < 0 ) { + info = info - 1; + } + } else if( matrix_layout == LAPACK_ROW_MAJOR ) { + lapack_int lda_t = MAX(1,n); + double* a_t = NULL; + /* Check leading dimension(s) */ + if( lda < n ) { + info = -5; + LAPACKE_xerbla( "LAPACKE_dsycon_3_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; + } + /* Transpose input matrices */ + LAPACKE_dsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + /* Call LAPACK function and adjust info */ + LAPACK_dsycon_3( &uplo, &n, a_t, &lda_t, e, ipiv, &anorm, rcond, work, iwork, + &info ); + if( info < 0 ) { + info = info - 1; + } + /* Release memory and exit */ + LAPACKE_free( a_t ); +exit_level_0: + if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_dsycon_3_work", info ); + } + } else { + info = -1; + LAPACKE_xerbla( "LAPACKE_dsycon_3_work", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_dsysv_rk.c b/LAPACKE/src/lapacke_dsysv_rk.c new file mode 100644 index 00000000..6be84bc5 --- /dev/null +++ b/LAPACKE/src/lapacke_dsysv_rk.c @@ -0,0 +1,83 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native high-level C interface to LAPACK function dsysv_rk +* Author: Intel Corporation +* Generated November 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_dsysv_rk( int matrix_layout, char uplo, lapack_int n, + lapack_int nrhs, double* a, lapack_int lda, + double* e, lapack_int* ipiv, double* b, lapack_int ldb ) +{ + lapack_int info = 0; + lapack_int lwork = -1; + double* work = NULL; + double work_query; + if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { + LAPACKE_xerbla( "LAPACKE_dsysv_rk", -1 ); + return -1; + } +#ifndef LAPACK_DISABLE_NAN_CHECK + /* Optionally check input matrices for NaNs */ + if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + return -5; + } + if( LAPACKE_d_nancheck( n, e, 1) ) { + return -7; + } + if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + return -9; + } +#endif + /* Query optimal working array(s) size */ + info = LAPACKE_dsysv_rk_work( matrix_layout, uplo, n, nrhs, a, lda, e, ipiv, b, + ldb, &work_query, lwork ); + if( info != 0 ) { + goto exit_level_0; + } + lwork = (lapack_int)work_query; + /* Allocate memory for work arrays */ + work = (double*)LAPACKE_malloc( sizeof(double) * lwork ); + if( work == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_0; + } + /* Call middle-level interface */ + info = LAPACKE_dsysv_rk_work( matrix_layout, uplo, n, nrhs, a, lda, e, ipiv, b, + ldb, work, lwork ); + /* Release memory and exit */ + LAPACKE_free( work ); +exit_level_0: + if( info == LAPACK_WORK_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_dsysv_rk", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_dsysv_rk_work.c b/LAPACKE/src/lapacke_dsysv_rk_work.c new file mode 100644 index 00000000..4636719f --- /dev/null +++ b/LAPACKE/src/lapacke_dsysv_rk_work.c @@ -0,0 +1,107 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native middle-level C interface to LAPACK function dsysv_rk +* Author: Intel Corporation +* Generated November 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_dsysv_rk_work( int matrix_layout, char uplo, lapack_int n, + lapack_int nrhs, double* a, lapack_int lda, + double* e, lapack_int* ipiv, double* b, lapack_int ldb, + double* work, lapack_int lwork ) +{ + lapack_int info = 0; + if( matrix_layout == LAPACK_COL_MAJOR ) { + /* Call LAPACK function and adjust info */ + LAPACK_dsysv_rk( &uplo, &n, &nrhs, a, &lda, e, ipiv, b, &ldb, work, &lwork, + &info ); + if( info < 0 ) { + info = info - 1; + } + } else if( matrix_layout == LAPACK_ROW_MAJOR ) { + lapack_int lda_t = MAX(1,n); + lapack_int ldb_t = MAX(1,n); + double* a_t = NULL; + double* b_t = NULL; + /* Check leading dimension(s) */ + if( lda < n ) { + info = -6; + LAPACKE_xerbla( "LAPACKE_dsysv_rk_work", info ); + return info; + } + if( ldb < nrhs ) { + info = -10; + LAPACKE_xerbla( "LAPACKE_dsysv_rk_work", info ); + return info; + } + /* Query optimal working array(s) size if requested */ + if( lwork == -1 ) { + LAPACK_dsysv_rk( &uplo, &n, &nrhs, a, &lda_t, e, ipiv, b, &ldb_t, work, + &lwork, &info ); + return (info < 0) ? (info - 1) : 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; + } + b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,nrhs) ); + if( b_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_1; + } + /* Transpose input matrices */ + LAPACKE_dsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + LAPACKE_dge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + /* Call LAPACK function and adjust info */ + LAPACK_dsysv_rk( &uplo, &n, &nrhs, a_t, &lda_t, e, ipiv, b_t, &ldb_t, work, + &lwork, &info ); + if( info < 0 ) { + info = info - 1; + } + /* Transpose output matrices */ + LAPACKE_dsy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + /* Release memory and exit */ + LAPACKE_free( b_t ); +exit_level_1: + LAPACKE_free( a_t ); +exit_level_0: + if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_dsysv_rk_work", info ); + } + } else { + info = -1; + LAPACKE_xerbla( "LAPACKE_dsysv_rk_work", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_dsytrf_rk.c b/LAPACKE/src/lapacke_dsytrf_rk.c new file mode 100644 index 00000000..09390039 --- /dev/null +++ b/LAPACKE/src/lapacke_dsytrf_rk.c @@ -0,0 +1,79 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native high-level C interface to LAPACK function dsytrf_rk +* Author: Intel Corporation +* Generated November 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_dsytrf_rk( int matrix_layout, char uplo, lapack_int n, double* a, + lapack_int lda, double* e, lapack_int* ipiv ) +{ + lapack_int info = 0; + lapack_int lwork = -1; + double* work = NULL; + double work_query; + if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { + LAPACKE_xerbla( "LAPACKE_dsytrf_rk", -1 ); + return -1; + } +#ifndef LAPACK_DISABLE_NAN_CHECK + /* Optionally check input matrices for NaNs */ + if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + return -4; + } + if( LAPACKE_d_nancheck( n, e, 1 ) ) { + return -6; + } +#endif + /* Query optimal working array(s) size */ + info = LAPACKE_dsytrf_rk_work( matrix_layout, uplo, n, a, lda, e, ipiv, + &work_query, lwork ); + if( info != 0 ) { + goto exit_level_0; + } + lwork = (lapack_int)work_query; + /* Allocate memory for work arrays */ + work = (double*)LAPACKE_malloc( sizeof(double) * lwork ); + if( work == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_0; + } + /* Call middle-level interface */ + info = LAPACKE_dsytrf_rk_work( matrix_layout, uplo, n, a, lda, e, ipiv, work, + lwork ); + /* Release memory and exit */ + LAPACKE_free( work ); +exit_level_0: + if( info == LAPACK_WORK_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_dsytrf_rk", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_dsytrf_rk_work.c b/LAPACKE/src/lapacke_dsytrf_rk_work.c new file mode 100644 index 00000000..2bdfc034 --- /dev/null +++ b/LAPACKE/src/lapacke_dsytrf_rk_work.c @@ -0,0 +1,87 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native middle-level C interface to LAPACK function dsytrf_rk +* Author: Intel Corporation +* Generated November 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_dsytrf_rk_work( int matrix_layout, char uplo, lapack_int n, + double* a, lapack_int lda, double* e, lapack_int* ipiv, + double* work, lapack_int lwork ) +{ + lapack_int info = 0; + if( matrix_layout == LAPACK_COL_MAJOR ) { + /* Call LAPACK function and adjust info */ + LAPACK_dsytrf_rk( &uplo, &n, a, &lda, e, ipiv, work, &lwork, &info ); + if( info < 0 ) { + info = info - 1; + } + } else if( matrix_layout == LAPACK_ROW_MAJOR ) { + lapack_int lda_t = MAX(1,n); + double* a_t = NULL; + /* Check leading dimension(s) */ + if( lda < n ) { + info = -5; + LAPACKE_xerbla( "LAPACKE_dsytrf_rk_work", info ); + return info; + } + /* Query optimal working array(s) size if requested */ + if( lwork == -1 ) { + LAPACK_dsytrf_rk( &uplo, &n, a, &lda_t, e, ipiv, work, &lwork, &info ); + return (info < 0) ? (info - 1) : 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; + } + /* Transpose input matrices */ + LAPACKE_dsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + /* Call LAPACK function and adjust info */ + LAPACK_dsytrf_rk( &uplo, &n, a_t, &lda_t, e, ipiv, work, &lwork, &info ); + if( info < 0 ) { + info = info - 1; + } + /* Transpose output matrices */ + LAPACKE_dsy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + /* Release memory and exit */ + LAPACKE_free( a_t ); +exit_level_0: + if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_dsytrf_rk_work", info ); + } + } else { + info = -1; + LAPACKE_xerbla( "LAPACKE_dsytrf_rk_work", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_dsytri_3.c b/LAPACKE/src/lapacke_dsytri_3.c new file mode 100644 index 00000000..739e01e7 --- /dev/null +++ b/LAPACKE/src/lapacke_dsytri_3.c @@ -0,0 +1,78 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native high-level C interface to LAPACK function dsytri_3 +* Author: Intel Corporation +* Generated November 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_dsytri_3( int matrix_layout, char uplo, lapack_int n, double* a, + lapack_int lda, const double* e, const lapack_int* ipiv ) +{ + lapack_int info = 0; + lapack_int lwork = -1; + double* work = NULL; + double work_query; + if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { + LAPACKE_xerbla( "LAPACKE_dsytri_3", -1 ); + return -1; + } +#ifndef LAPACK_DISABLE_NAN_CHECK + /* Optionally check input matrices for NaNs */ + if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + return -4; + } + if( LAPACKE_d_nancheck( n, e, 1 ) ) { + return -6; + } +#endif + /* Query optimal working array(s) size */ + info = LAPACKE_dsytri_3_work( matrix_layout, uplo, n, a, lda, e, ipiv, + &work_query, lwork ); + if( info != 0 ) { + goto exit_level_0; + } + lwork = (lapack_int)work_query; + /* Allocate memory for working array(s) */ + work = (double*)LAPACKE_malloc( sizeof(double) * lwork ); + if( work == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_0; + } + /* Call middle-level interface */ + info = LAPACKE_dsytri_3_work( matrix_layout, uplo, n, a, lda, e, ipiv, work, lwork ); + /* Release memory and exit */ + LAPACKE_free( work ); +exit_level_0: + if( info == LAPACK_WORK_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_dsytri_3", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_dsytri_3_work.c b/LAPACKE/src/lapacke_dsytri_3_work.c new file mode 100644 index 00000000..689d8993 --- /dev/null +++ b/LAPACKE/src/lapacke_dsytri_3_work.c @@ -0,0 +1,87 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native middle-level C interface to LAPACK function dsytri_3 +* Author: Intel Corporation +* Generated November 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_dsytri_3_work( int matrix_layout, char uplo, lapack_int n, + double* a, lapack_int lda, const double* e, + const lapack_int* ipiv, double* work, lapack_int lwork) +{ + lapack_int info = 0; + if( matrix_layout == LAPACK_COL_MAJOR ) { + /* Call LAPACK function and adjust info */ + LAPACK_dsytri_3( &uplo, &n, a, &lda, e, ipiv, work, &lwork, &info ); + if( info < 0 ) { + info = info - 1; + } + } else if( matrix_layout == LAPACK_ROW_MAJOR ) { + lapack_int lda_t = MAX(1,n); + double* a_t = NULL; + /* Check leading dimension(s) */ + if( lda < n ) { + info = -5; + LAPACKE_xerbla( "LAPACKE_dsytri_3_work", info ); + return info; + } + /* Query optimal working array(s) size if requested */ + if( lwork == -1 ) { + LAPACK_dsytri_3( &uplo, &n, a_t, &lda_t, e, ipiv, work, &lwork, &info ); + return (info < 0) ? (info - 1) : 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; + } + /* Transpose input matrices */ + LAPACKE_dsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + /* Call LAPACK function and adjust info */ + LAPACK_dsytri_3( &uplo, &n, a_t, &lda_t, e, ipiv, work, &lwork, &info ); + if( info < 0 ) { + info = info - 1; + } + /* Transpose output matrices */ + LAPACKE_dsy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + /* Release memory and exit */ + LAPACKE_free( a_t ); +exit_level_0: + if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_dsytri_3_work", info ); + } + } else { + info = -1; + LAPACKE_xerbla( "LAPACKE_dsytri_3_work", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_dsytrs_3.c b/LAPACKE/src/lapacke_dsytrs_3.c new file mode 100644 index 00000000..5d9e57a9 --- /dev/null +++ b/LAPACKE/src/lapacke_dsytrs_3.c @@ -0,0 +1,59 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native high-level C interface to LAPACK function dsytrs_3 +* Author: Intel Corporation +* Generated November 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_dsytrs_3( int matrix_layout, char uplo, lapack_int n, + lapack_int nrhs, const double* a, lapack_int lda, + const double* e, + const lapack_int* ipiv, double* b, lapack_int ldb ) +{ + if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { + LAPACKE_xerbla( "LAPACKE_dsytrs_3", -1 ); + return -1; + } +#ifndef LAPACK_DISABLE_NAN_CHECK + /* Optionally check input matrices for NaNs */ + if( LAPACKE_dsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + return -5; + } + if( LAPACKE_d_nancheck( n, e ,1 ) ) { + return -7; + } + if( LAPACKE_dge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + return -9; + } +#endif + return LAPACKE_dsytrs_3_work( matrix_layout, uplo, n, nrhs, a, lda, + e, ipiv, b, ldb ); +} diff --git a/LAPACKE/src/lapacke_dsytrs_3_work.c b/LAPACKE/src/lapacke_dsytrs_3_work.c new file mode 100644 index 00000000..e4bbefc7 --- /dev/null +++ b/LAPACKE/src/lapacke_dsytrs_3_work.c @@ -0,0 +1,99 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native middle-level C interface to LAPACK function dsytrs_3 +* Author: Intel Corporation +* Generated November 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_dsytrs_3_work( int matrix_layout, char uplo, lapack_int n, + lapack_int nrhs, const double* a, + lapack_int lda, const double* e, + const lapack_int* ipiv, double* b, lapack_int ldb ) +{ + lapack_int info = 0; + if( matrix_layout == LAPACK_COL_MAJOR ) { + /* Call LAPACK function and adjust info */ + LAPACK_dsytrs_3( &uplo, &n, &nrhs, a, &lda, e, ipiv, b, &ldb, &info ); + if( info < 0 ) { + info = info - 1; + } + } else if( matrix_layout == LAPACK_ROW_MAJOR ) { + lapack_int lda_t = MAX(1,n); + lapack_int ldb_t = MAX(1,n); + double* a_t = NULL; + double* b_t = NULL; + /* Check leading dimension(s) */ + if( lda < n ) { + info = -6; + LAPACKE_xerbla( "LAPACKE_dsytrs_3_work", info ); + return info; + } + if( ldb < nrhs ) { + info = -10; + LAPACKE_xerbla( "LAPACKE_dsytrs_3_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; + } + b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,nrhs) ); + if( b_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_1; + } + /* Transpose input matrices */ + LAPACKE_dsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + LAPACKE_dge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + /* Call LAPACK function and adjust info */ + LAPACK_dsytrs_3( &uplo, &n, &nrhs, a_t, &lda_t, e, ipiv, b_t, &ldb_t, + &info ); + if( info < 0 ) { + info = info - 1; + } + /* Transpose output matrices */ + LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + /* Release memory and exit */ + LAPACKE_free( b_t ); +exit_level_1: + LAPACKE_free( a_t ); +exit_level_0: + if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_dsytrs_3_work", info ); + } + } else { + info = -1; + LAPACKE_xerbla( "LAPACKE_dsytrs_3_work", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_sgelq.c b/LAPACKE/src/lapacke_sgelq.c new file mode 100644 index 00000000..7cbc7700 --- /dev/null +++ b/LAPACKE/src/lapacke_sgelq.c @@ -0,0 +1,79 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native high-level C interface to LAPACK function sgelq +* Author: Intel Corporation +* Generated November 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_sgelq_work( int matrix_layout, lapack_int m, lapack_int n, + float* a, lapack_int lda, + float* t, lapack_int tsize ) +{ + lapack_int info = 0; + lapack_int lwork = -1; + float* work = NULL; + float work_query; + if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { + LAPACKE_xerbla( "LAPACKE_sgelq", -1 ); + return -1; + } +#ifndef LAPACK_DISABLE_NAN_CHECK + /* Optionally check input matrices for NaNs */ + if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) { + return -4; + } +#endif + /* Query optimal working array(s) size */ + info = LAPACKE_sgelq_work( matrix_layout, m, n, a, lda, t, tsize, &work_query, + lwork ); + if( info != 0 ) { + goto exit_level_0; + } + if( tsize == -1 || tsize == -2 ) { + goto exit_level_0; + } + lwork = (lapack_int)work_query; + /* Allocate memory for work arrays */ + work = (float*)LAPACKE_malloc( sizeof(float) * lwork ); + if( work == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_0; + } + /* Call middle-level interface */ + info = LAPACKE_sgelq_work( matrix_layout, m, n, a, lda, t, tsize, work, lwork ); + /* Release memory and exit */ + LAPACKE_free( work ); +exit_level_0: + if( info == LAPACK_WORK_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_sgelq", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_sgelq_work.c b/LAPACKE/src/lapacke_sgelq_work.c new file mode 100644 index 00000000..437c57b1 --- /dev/null +++ b/LAPACKE/src/lapacke_sgelq_work.c @@ -0,0 +1,88 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native middle-level C interface to LAPACK function sgelq +* Author: Intel Corporation +* Generated November 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_sgelq_work( int matrix_layout, lapack_int m, lapack_int n, + float* a, lapack_int lda, + float* t, lapack_int tsize, + float* work, lapack_int lwork ) +{ + lapack_int info = 0; + if( matrix_layout == LAPACK_COL_MAJOR ) { + /* Call LAPACK function and adjust info */ + LAPACK_sgelq( &m, &n, a, &lda, t, &tsize, work, &lwork, &info ); + if( info < 0 ) { + info = info - 1; + } + } else if( matrix_layout == LAPACK_ROW_MAJOR ) { + lapack_int lda_t = MAX(1,m); + float* a_t = NULL; + /* Check leading dimension(s) */ + if( lda < n ) { + info = -5; + LAPACKE_xerbla( "LAPACKE_sgelq_work", info ); + return info; + } + /* Query optimal working array(s) size if requested */ + if( tsize == -1 || tsize == -2 || lwork == -1 || lwork == -2) { + LAPACK_sgelq( &m, &n, a, &lda_t, t, &tsize, work, &lwork, &info ); + return (info < 0) ? (info - 1) : 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; + } + /* Transpose input matrices */ + LAPACKE_sge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + /* Call LAPACK function and adjust info */ + LAPACK_sgelq( &m, &n, a_t, &lda_t, t, &tsize, work, &lwork, &info ); + if( info < 0 ) { + info = info - 1; + } + /* Transpose output matrices */ + LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + /* Release memory and exit */ + LAPACKE_free( a_t ); +exit_level_0: + if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_sgelq_work", info ); + } + } else { + info = -1; + LAPACKE_xerbla( "LAPACKE_sgelq_work", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_sgemlq.c b/LAPACKE/src/lapacke_sgemlq.c new file mode 100644 index 00000000..162c1c7a --- /dev/null +++ b/LAPACKE/src/lapacke_sgemlq.c @@ -0,0 +1,85 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native high-level C interface to LAPACK function sgemlq +* Author: Intel Corporation +* Generated November 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_sgemlq( int matrix_layout, char side, char trans, + lapack_int m, lapack_int n, lapack_int k, + const float* a, lapack_int lda, + const float* t, lapack_int tsize, + float* c, lapack_int ldc ) +{ + lapack_int info = 0; + lapack_int lwork = -1; + float* work = NULL; + float work_query; + if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { + LAPACKE_xerbla( "LAPACKE_sgemlq", -1 ); + return -1; + } +#ifndef LAPACK_DISABLE_NAN_CHECK + /* Optionally check input matrices for NaNs */ + if( LAPACKE_sge_nancheck( matrix_layout, k, m, a, lda ) ) { + return -7; + } + if( LAPACKE_sge_nancheck( matrix_layout, m, n, c, ldc ) ) { + return -10; + } + if( LAPACKE_d_nancheck( tsize, t, 1 ) ) { + return -9; + } +#endif + /* Query optimal working array(s) size */ + info = LAPACKE_sgemlq_work( matrix_layout, side, trans, m, n, k, a, lda, + t, tsize, c, ldc, &work_query, lwork ); + if( info != 0 ) { + goto exit_level_0; + } + lwork = (lapack_int)work_query; + /* Allocate memory for work arrays */ + work = (float*)LAPACKE_malloc( sizeof(float) * lwork ); + if( work == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_0; + } + /* Call middle-level interface */ + info = LAPACKE_sgemlq_work( matrix_layout, side, trans, m, n, k, a, lda, + t, tsize, c, ldc, work, lwork ); + /* Release memory and exit */ + LAPACKE_free( work ); +exit_level_0: + if( info == LAPACK_WORK_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_sgemlq", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_sgemlq_work.c b/LAPACKE/src/lapacke_sgemlq_work.c new file mode 100644 index 00000000..9931ec13 --- /dev/null +++ b/LAPACKE/src/lapacke_sgemlq_work.c @@ -0,0 +1,114 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native middle-level C interface to LAPACK function sgemlq +* Author: Intel Corporation +* Generated June 2016 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_sgemlq_work( int matrix_layout, char side, char trans, + lapack_int m, lapack_int n, lapack_int k, + const float* a, lapack_int lda, + const float* t, lapack_int tsize, + float* c, lapack_int ldc, + float* work, lapack_int lwork ) +{ + lapack_int info = 0; + lapack_int r; + lapack_int lda_t, ldc_t; + float *a_t = NULL, *c_t = NULL; + if( matrix_layout == LAPACK_COL_MAJOR ) { + /* Call LAPACK function and adjust info */ + LAPACK_sgemlq( &side, &trans, &m, &n, &k, a, &lda, t, &tsize, + c, &ldc, work, &lwork, &info ); + if( info < 0 ) { + info = info - 1; + } + } else if( matrix_layout == LAPACK_ROW_MAJOR ) { + r = LAPACKE_lsame( side, 'l' ) ? m : n; + lda_t = MAX(1,k); + ldc_t = MAX(1,m); + /* Check leading dimension(s) */ + if( lda < r ) { + info = -8; + LAPACKE_xerbla( "LAPACKE_sgemlq_work", info ); + return info; + } + if( ldc < n ) { + info = -11; + LAPACKE_xerbla( "LAPACKE_sgemlq_work", info ); + return info; + } + /* Query optimal working array(s) size if requested */ + if( lwork == -1 ) { + LAPACK_sgemlq( &side, &trans, &m, &n, &k, a, &lda_t, t, &tsize, + c, &ldc_t, work, &lwork, &info ); + return (info < 0) ? (info - 1) : info; + } + /* Allocate memory for temporary array(s) */ + if( LAPACKE_lsame( side, 'l' ) ) { + a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,m) ); + } else { + 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; + } + c_t = (float*)LAPACKE_malloc( sizeof(float) * ldc_t * MAX(1,n) ); + if( c_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_1; + } + /* Transpose input matrices */ + LAPACKE_sge_trans( matrix_layout, k, m, a, lda, a_t, lda_t ); + LAPACKE_sge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t ); + /* Call LAPACK function and adjust info */ + LAPACK_sgemlq( &side, &trans, &m, &n, &k, a_t, &lda_t, t, &tsize, + c_t, &ldc_t, work, &lwork, &info ); + if( info < 0 ) { + info = info - 1; + } + /* Transpose output matrices */ + LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); + /* Release memory and exit */ + LAPACKE_free( c_t ); +exit_level_1: + LAPACKE_free( a_t ); +exit_level_0: + if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_sgemlq_work", info ); + } + } else { + info = -1; + LAPACKE_xerbla( "LAPACKE_sgemlq_work", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_sgemqr.c b/LAPACKE/src/lapacke_sgemqr.c new file mode 100644 index 00000000..4619d927 --- /dev/null +++ b/LAPACKE/src/lapacke_sgemqr.c @@ -0,0 +1,87 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native high-level C interface to LAPACK function sgemqr +* Author: Intel Corporation +* Generated December 2016 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_sgemqr( int matrix_layout, char side, char trans, + lapack_int m, lapack_int n, lapack_int k, + const float* a, lapack_int lda, + const float* t, lapack_int tsize, + float* c, lapack_int ldc ) +{ + lapack_int info = 0; + lapack_int lwork = -1; + float* work = NULL; + float work_query; + lapack_int r; + if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { + LAPACKE_xerbla( "LAPACKE_sgemqr", -1 ); + return -1; + } +#ifndef LAPACK_DISABLE_NAN_CHECK + /* Optionally check input matrices for NaNs */ + r = LAPACKE_lsame( side, 'l' ) ? m : n; + if( LAPACKE_sge_nancheck( matrix_layout, r, k, a, lda ) ) { + return -7; + } + if( LAPACKE_sge_nancheck( matrix_layout, m, n, c, ldc ) ) { + return -10; + } + if( LAPACKE_s_nancheck( tsize, t, 1 ) ) { + return -9; + } +#endif + /* Query optimal working array(s) size */ + info = LAPACKE_sgemqr_work( matrix_layout, side, trans, m, n, k, a, lda, + t, tsize, c, ldc, &work_query, lwork ); + if( info != 0 ) { + goto exit_level_0; + } + lwork = (lapack_int)work_query; + /* Allocate memory for work arrays */ + work = (float*)LAPACKE_malloc( sizeof(float) * lwork ); + if( work == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_0; + } + /* Call middle-level interface */ + info = LAPACKE_sgemqr_work( matrix_layout, side, trans, m, n, k, a, lda, + t, tsize, c, ldc, work, lwork ); + /* Release memory and exit */ + LAPACKE_free( work ); +exit_level_0: + if( info == LAPACK_WORK_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_sgemqr", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_sgemqr_work.c b/LAPACKE/src/lapacke_sgemqr_work.c new file mode 100644 index 00000000..d41b500c --- /dev/null +++ b/LAPACKE/src/lapacke_sgemqr_work.c @@ -0,0 +1,112 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native middle-level C interface to LAPACK function sgemqr +* Author: Intel Corporation +* Generated December 2016 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_sgemqr_work( int matrix_layout, char side, char trans, + lapack_int m, lapack_int n, lapack_int k, + const float* a, lapack_int lda, + const float* t, lapack_int tsize, + float* c, lapack_int ldc, + float* work, lapack_int lwork ) +{ + lapack_int info = 0; + lapack_int r; + lapack_int lda_t, ldc_t; + float *a_t = NULL, *c_t = NULL; + if( matrix_layout == LAPACK_COL_MAJOR ) { + /* Call LAPACK function and adjust info */ + LAPACK_sgemqr( &side, &trans, &m, &n, &k, a, &lda, t, &tsize, c, &ldc, + work, &lwork, &info ); + if( info < 0 ) { + info = info - 1; + } + } else if( matrix_layout == LAPACK_ROW_MAJOR ) { + r = LAPACKE_lsame( side, 'l' ) ? m : n; + lda_t = MAX(1,r); + ldc_t = MAX(1,m); + /* Check leading dimension(s) */ + if( lda < k ) { + info = -8; + LAPACKE_xerbla( "LAPACKE_sgemqr_work", info ); + return info; + } + if( ldc < n ) { + info = -11; + LAPACKE_xerbla( "LAPACKE_sgemqr_work", info ); + return info; + } + /* Query optimal working array(s) size if requested */ + if( lwork == -1 ) { + LAPACK_sgemqr( &side, &trans, &m, &n, &k, a, &lda_t, t, &tsize, + c, &ldc_t, work, &lwork, &info ); + return (info < 0) ? (info - 1) : info; + } + /* Allocate memory for temporary array(s) */ + a_t = (float*) + LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,k) ); + if( a_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_0; + } + c_t = (float*) + LAPACKE_malloc( sizeof(float) * ldc_t * MAX(1,n) ); + if( c_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_1; + } + /* Transpose input matrices */ + LAPACKE_sge_trans( matrix_layout, r, k, a, lda, a_t, lda_t ); + LAPACKE_sge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t ); + /* Call LAPACK function and adjust info */ + LAPACK_sgemqr( &side, &trans, &m, &n, &k, a_t, &lda_t, t, &tsize, + c_t, &ldc_t, work, &lwork, &info ); + if( info < 0 ) { + info = info - 1; + } + /* Transpose output matrices */ + LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); + /* Release memory and exit */ + LAPACKE_free( c_t ); +exit_level_1: + LAPACKE_free( a_t ); +exit_level_0: + if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_sgemqr_work", info ); + } + } else { + info = -1; + LAPACKE_xerbla( "LAPACKE_sgemqr_work", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_sgeqr.c b/LAPACKE/src/lapacke_sgeqr.c new file mode 100644 index 00000000..60323f53 --- /dev/null +++ b/LAPACKE/src/lapacke_sgeqr.c @@ -0,0 +1,79 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native high-level C interface to LAPACK function sgeqr +* Author: Intel Corporation +* Generated December 2016 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_sgeqr( int matrix_layout, lapack_int m, lapack_int n, + float* a, lapack_int lda, + float* t, lapack_int tsize ) +{ + lapack_int info = 0; + lapack_int lwork = -1; + float* work = NULL; + float work_query; + if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { + LAPACKE_xerbla( "LAPACKE_sgeqr", -1 ); + return -1; + } +#ifndef LAPACK_DISABLE_NAN_CHECK + /* Optionally check input matrices for NaNs */ + if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) { + return -4; + } +#endif + /* Query optimal working array(s) size */ + info = LAPACKE_sgeqr_work( matrix_layout, m, n, a, lda, t, tsize, &work_query, + lwork ); + if( info != 0 ) { + goto exit_level_0; + } + if( tsize == -1 || tsize == -2 ) { + goto exit_level_0; + } + lwork = (lapack_int)work_query; + /* Allocate memory for work arrays */ + work = (float*)LAPACKE_malloc( sizeof(float) * lwork ); + if( work == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_0; + } + /* Call middle-level interface */ + info = LAPACKE_sgeqr_work( matrix_layout, m, n, a, lda, t, tsize, work, lwork ); + /* Release memory and exit */ + LAPACKE_free( work ); +exit_level_0: + if( info == LAPACK_WORK_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_sgeqr", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_sgeqr_work.c b/LAPACKE/src/lapacke_sgeqr_work.c new file mode 100644 index 00000000..21c222a9 --- /dev/null +++ b/LAPACKE/src/lapacke_sgeqr_work.c @@ -0,0 +1,89 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native middle-level C interface to LAPACK function sgeqr +* Author: Intel Corporation +* Generated December 2016 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_sgeqr_work( int matrix_layout, lapack_int m, lapack_int n, + float* a, lapack_int lda, + float* t, lapack_int tsize, + float* work, lapack_int lwork ) +{ + lapack_int info = 0; + if( matrix_layout == LAPACK_COL_MAJOR ) { + /* Call LAPACK function and adjust info */ + LAPACK_sgeqr( &m, &n, a, &lda, t, &tsize, work, &lwork, &info ); + if( info < 0 ) { + info = info - 1; + } + } else if( matrix_layout == LAPACK_ROW_MAJOR ) { + lapack_int lda_t = MAX(1,m); + float* a_t = NULL; + /* Check leading dimension(s) */ + if( lda < n ) { + info = -5; + LAPACKE_xerbla( "LAPACKE_sgeqr_work", info ); + return info; + } + /* Query optimal working array(s) size if requested */ + if( tsize == -1 || tsize == -2 || lwork == -1 || lwork == -2) { + LAPACK_sgeqr( &m, &n, a, &lda_t, t, &tsize, work, &lwork, &info ); + return (info < 0) ? (info - 1) : 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; + } + /* Transpose input matrices */ + LAPACKE_sge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + /* Call LAPACK function and adjust info */ + LAPACK_sgeqr( &m, &n, a_t, &lda_t, t, &tsize, work, &lwork, &info ); + if( info < 0 ) { + info = info - 1; + } + /* Transpose output matrices */ + LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + /* Release memory and exit */ + LAPACKE_free( a_t ); +exit_level_0: + if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_sgeqr_work", info ); + } + } else { + info = -1; + LAPACKE_xerbla( "LAPACKE_sgeqr_work", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_sgetsls.c b/LAPACKE/src/lapacke_sgetsls.c new file mode 100644 index 00000000..1a1d8f3a --- /dev/null +++ b/LAPACKE/src/lapacke_sgetsls.c @@ -0,0 +1,80 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native high-level C interface to LAPACK function sgetsls +* Author: Intel Corporation +* Generated December 2016 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_sgetsls( int matrix_layout, char trans, lapack_int m, + lapack_int n, lapack_int nrhs, float* a, + lapack_int lda, float* b, lapack_int ldb ) +{ + lapack_int info = 0; + lapack_int lwork = -1; + float* work = NULL; + float work_query; + if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { + LAPACKE_xerbla( "LAPACKE_sgetsls", -1 ); + return -1; + } +#ifndef LAPACK_DISABLE_NAN_CHECK + /* Optionally check input matrices for NaNs */ + if( LAPACKE_sge_nancheck( matrix_layout, m, n, a, lda ) ) { + return -6; + } + if( LAPACKE_sge_nancheck( matrix_layout, MAX(m,n), nrhs, b, ldb ) ) { + return -8; + } +#endif + /* Query optimal working array(s) size */ + info = LAPACKE_sgetsls_work( matrix_layout, trans, m, n, nrhs, a, lda, b, ldb, + &work_query, lwork ); + if( info != 0 ) { + goto exit_level_0; + } + lwork = (lapack_int)work_query; + /* Allocate memory for work arrays */ + work = (float*)LAPACKE_malloc( sizeof(float) * lwork ); + if( work == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_0; + } + /* Call middle-level interface */ + info = LAPACKE_sgetsls_work( matrix_layout, trans, m, n, nrhs, a, lda, b, ldb, + work, lwork ); + /* Release memory and exit */ + LAPACKE_free( work ); +exit_level_0: + if( info == LAPACK_WORK_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_sgetsls", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_sgetsls_work.c b/LAPACKE/src/lapacke_sgetsls_work.c new file mode 100644 index 00000000..6f36379c --- /dev/null +++ b/LAPACKE/src/lapacke_sgetsls_work.c @@ -0,0 +1,108 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native middle-level C interface to LAPACK function sgetsls +* Author: Intel Corporation +* Generated December 2016 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_sgetsls_work( int matrix_layout, char trans, lapack_int m, + lapack_int n, lapack_int nrhs, float* a, + lapack_int lda, float* b, lapack_int ldb, + float* work, lapack_int lwork ) +{ + lapack_int info = 0; + if( matrix_layout == LAPACK_COL_MAJOR ) { + /* Call LAPACK function and adjust info */ + LAPACK_sgetsls( &trans, &m, &n, &nrhs, a, &lda, b, &ldb, work, &lwork, + &info ); + if( info < 0 ) { + info = info - 1; + } + } else if( matrix_layout == LAPACK_ROW_MAJOR ) { + lapack_int lda_t = MAX(1,m); + lapack_int ldb_t = MAX(1,MAX(m,n)); + float* a_t = NULL; + float* b_t = NULL; + /* Check leading dimension(s) */ + if( lda < n ) { + info = -7; + LAPACKE_xerbla( "LAPACKE_sgetsls_work", info ); + return info; + } + if( ldb < nrhs ) { + info = -9; + LAPACKE_xerbla( "LAPACKE_sgetsls_work", info ); + return info; + } + /* Query optimal working array(s) size if requested */ + if( lwork == -1 ) { + LAPACK_sgetsls( &trans, &m, &n, &nrhs, a, &lda_t, b, &ldb_t, work, + &lwork, &info ); + return (info < 0) ? (info - 1) : 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; + } + b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,nrhs) ); + if( b_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 ); + LAPACKE_sge_trans( matrix_layout, MAX(m,n), nrhs, b, ldb, b_t, ldb_t ); + /* Call LAPACK function and adjust info */ + LAPACK_sgetsls( &trans, &m, &n, &nrhs, a_t, &lda_t, b_t, &ldb_t, work, + &lwork, &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, MAX(m,n), nrhs, b_t, ldb_t, b, + ldb ); + /* Release memory and exit */ + LAPACKE_free( b_t ); +exit_level_1: + LAPACKE_free( a_t ); +exit_level_0: + if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_sgetsls_work", info ); + } + } else { + info = -1; + LAPACKE_xerbla( "LAPACKE_sgetsls_work", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_ssycon_3.c b/LAPACKE/src/lapacke_ssycon_3.c new file mode 100644 index 00000000..9501821a --- /dev/null +++ b/LAPACKE/src/lapacke_ssycon_3.c @@ -0,0 +1,82 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native high-level C interface to LAPACK function ssycon_3 +* Author: Intel Corporation +* Generated November 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_ssycon_3( int matrix_layout, char uplo, lapack_int n, + const float* a, lapack_int lda, const float* e, + const lapack_int* ipiv, float anorm, float* rcond ) +{ + lapack_int info = 0; + lapack_int* iwork = NULL; + float* work = NULL; + if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { + LAPACKE_xerbla( "LAPACKE_ssycon_3", -1 ); + return -1; + } +#ifndef LAPACK_DISABLE_NAN_CHECK + /* Optionally check input matrices for NaNs */ + if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + return -4; + } + if( LAPACKE_s_nancheck( n, e, 1 ) ) { + return -6; + } + if( LAPACKE_s_nancheck( 1, &anorm, 1 ) ) { + return -8; + } +#endif + /* Allocate memory for working array(s) */ + iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n) ); + if( iwork == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_0; + } + work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,2*n) ); + if( work == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_1; + } + /* Call middle-level interface */ + info = LAPACKE_ssycon_3_work( matrix_layout, uplo, n, a, lda, e, ipiv, anorm, + rcond, work, iwork ); + /* Release memory and exit */ + LAPACKE_free( work ); +exit_level_1: + LAPACKE_free( iwork ); +exit_level_0: + if( info == LAPACK_WORK_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_ssycon_3", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_ssycon_3_work.c b/LAPACKE/src/lapacke_ssycon_3_work.c new file mode 100644 index 00000000..37ccb068 --- /dev/null +++ b/LAPACKE/src/lapacke_ssycon_3_work.c @@ -0,0 +1,83 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native middle-level C interface to LAPACK function ssycon_3 +* Author: Intel Corporation +* Generated November 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_ssycon_3_work( int matrix_layout, char uplo, lapack_int n, + const float* a, lapack_int lda, + const float* e, const lapack_int* ipiv, float anorm, + float* rcond, float* work, lapack_int* iwork ) +{ + lapack_int info = 0; + if( matrix_layout == LAPACK_COL_MAJOR ) { + /* Call LAPACK function and adjust info */ + LAPACK_ssycon_3( &uplo, &n, a, &lda, e, ipiv, &anorm, rcond, work, iwork, + &info ); + if( info < 0 ) { + info = info - 1; + } + } else if( matrix_layout == LAPACK_ROW_MAJOR ) { + lapack_int lda_t = MAX(1,n); + float* a_t = NULL; + /* Check leading dimension(s) */ + if( lda < n ) { + info = -5; + LAPACKE_xerbla( "LAPACKE_ssycon_3_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; + } + /* Transpose input matrices */ + LAPACKE_ssy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + /* Call LAPACK function and adjust info */ + LAPACK_ssycon_3( &uplo, &n, a_t, &lda_t, e, ipiv, &anorm, rcond, work, iwork, + &info ); + if( info < 0 ) { + info = info - 1; + } + /* Release memory and exit */ + LAPACKE_free( a_t ); +exit_level_0: + if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_ssycon_3_work", info ); + } + } else { + info = -1; + LAPACKE_xerbla( "LAPACKE_ssycon_3_work", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_ssysv_rk.c b/LAPACKE/src/lapacke_ssysv_rk.c new file mode 100644 index 00000000..1ebc9028 --- /dev/null +++ b/LAPACKE/src/lapacke_ssysv_rk.c @@ -0,0 +1,83 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native high-level C interface to LAPACK function ssysv_rk +* Author: Intel Corporation +* Generated November 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_ssysv_rk( int matrix_layout, char uplo, lapack_int n, + lapack_int nrhs, float* a, lapack_int lda, + float* e, lapack_int* ipiv, float* b, lapack_int ldb ) +{ + lapack_int info = 0; + lapack_int lwork = -1; + float* work = NULL; + float work_query; + if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { + LAPACKE_xerbla( "LAPACKE_ssysv_rk", -1 ); + return -1; + } +#ifndef LAPACK_DISABLE_NAN_CHECK + /* Optionally check input matrices for NaNs */ + if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + return -5; + } + if( LAPACKE_s_nancheck( n, e, 1) ) { + return -7; + } + if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + return -9; + } +#endif + /* Query optimal working array(s) size */ + info = LAPACKE_ssysv_rk_work( matrix_layout, uplo, n, nrhs, a, lda, e, ipiv, b, + ldb, &work_query, lwork ); + if( info != 0 ) { + goto exit_level_0; + } + lwork = (lapack_int)work_query; + /* Allocate memory for work arrays */ + work = (float*)LAPACKE_malloc( sizeof(float) * lwork ); + if( work == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_0; + } + /* Call middle-level interface */ + info = LAPACKE_ssysv_rk_work( matrix_layout, uplo, n, nrhs, a, lda, e, ipiv, b, + ldb, work, lwork ); + /* Release memory and exit */ + LAPACKE_free( work ); +exit_level_0: + if( info == LAPACK_WORK_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_ssysv_rk", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_ssysv_rk_work.c b/LAPACKE/src/lapacke_ssysv_rk_work.c new file mode 100644 index 00000000..f3a46d2d --- /dev/null +++ b/LAPACKE/src/lapacke_ssysv_rk_work.c @@ -0,0 +1,107 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native middle-level C interface to LAPACK function ssysv_rk +* Author: Intel Corporation +* Generated November 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_ssysv_rk_work( int matrix_layout, char uplo, lapack_int n, + lapack_int nrhs, float* a, lapack_int lda, + float* e, lapack_int* ipiv, float* b, lapack_int ldb, + float* work, lapack_int lwork ) +{ + lapack_int info = 0; + if( matrix_layout == LAPACK_COL_MAJOR ) { + /* Call LAPACK function and adjust info */ + LAPACK_ssysv_rk( &uplo, &n, &nrhs, a, &lda, e, ipiv, b, &ldb, work, &lwork, + &info ); + if( info < 0 ) { + info = info - 1; + } + } else if( matrix_layout == LAPACK_ROW_MAJOR ) { + lapack_int lda_t = MAX(1,n); + lapack_int ldb_t = MAX(1,n); + float* a_t = NULL; + float* b_t = NULL; + /* Check leading dimension(s) */ + if( lda < n ) { + info = -6; + LAPACKE_xerbla( "LAPACKE_ssysv_rk_work", info ); + return info; + } + if( ldb < nrhs ) { + info = -10; + LAPACKE_xerbla( "LAPACKE_ssysv_rk_work", info ); + return info; + } + /* Query optimal working array(s) size if requested */ + if( lwork == -1 ) { + LAPACK_ssysv_rk( &uplo, &n, &nrhs, a, &lda_t, e, ipiv, b, &ldb_t, work, + &lwork, &info ); + return (info < 0) ? (info - 1) : 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; + } + b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,nrhs) ); + if( b_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_1; + } + /* Transpose input matrices */ + LAPACKE_ssy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + LAPACKE_sge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + /* Call LAPACK function and adjust info */ + LAPACK_ssysv_rk( &uplo, &n, &nrhs, a_t, &lda_t, e, ipiv, b_t, &ldb_t, work, + &lwork, &info ); + if( info < 0 ) { + info = info - 1; + } + /* Transpose output matrices */ + LAPACKE_ssy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + /* Release memory and exit */ + LAPACKE_free( b_t ); +exit_level_1: + LAPACKE_free( a_t ); +exit_level_0: + if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_ssysv_rk_work", info ); + } + } else { + info = -1; + LAPACKE_xerbla( "LAPACKE_ssysv_rk_work", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_ssytrf_rk.c b/LAPACKE/src/lapacke_ssytrf_rk.c new file mode 100644 index 00000000..4e0941eb --- /dev/null +++ b/LAPACKE/src/lapacke_ssytrf_rk.c @@ -0,0 +1,79 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native high-level C interface to LAPACK function ssytrf_rk +* Author: Intel Corporation +* Generated November 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_ssytrf_rk( int matrix_layout, char uplo, lapack_int n, float* a, + lapack_int lda, float* e, lapack_int* ipiv ) +{ + lapack_int info = 0; + lapack_int lwork = -1; + float* work = NULL; + float work_query; + if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { + LAPACKE_xerbla( "LAPACKE_ssytrf_rk", -1 ); + return -1; + } +#ifndef LAPACK_DISABLE_NAN_CHECK + /* Optionally check input matrices for NaNs */ + if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + return -4; + } + if( LAPACKE_s_nancheck( n, e, 1 ) ) { + return -6; + } +#endif + /* Query optimal working array(s) size */ + info = LAPACKE_ssytrf_rk_work( matrix_layout, uplo, n, a, lda, e, ipiv, + &work_query, lwork ); + if( info != 0 ) { + goto exit_level_0; + } + lwork = (lapack_int)work_query; + /* Allocate memory for work arrays */ + work = (float*)LAPACKE_malloc( sizeof(float) * lwork ); + if( work == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_0; + } + /* Call middle-level interface */ + info = LAPACKE_ssytrf_rk_work( matrix_layout, uplo, n, a, lda, e, ipiv, work, + lwork ); + /* Release memory and exit */ + LAPACKE_free( work ); +exit_level_0: + if( info == LAPACK_WORK_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_ssytrf_rk", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_ssytrf_rk_work.c b/LAPACKE/src/lapacke_ssytrf_rk_work.c new file mode 100644 index 00000000..a163165f --- /dev/null +++ b/LAPACKE/src/lapacke_ssytrf_rk_work.c @@ -0,0 +1,87 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native middle-level C interface to LAPACK function ssytrf_rk +* Author: Intel Corporation +* Generated November 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_ssytrf_rk_work( int matrix_layout, char uplo, lapack_int n, + float* a, lapack_int lda, float* e, lapack_int* ipiv, + float* work, lapack_int lwork ) +{ + lapack_int info = 0; + if( matrix_layout == LAPACK_COL_MAJOR ) { + /* Call LAPACK function and adjust info */ + LAPACK_ssytrf_rk( &uplo, &n, a, &lda, e, ipiv, work, &lwork, &info ); + if( info < 0 ) { + info = info - 1; + } + } else if( matrix_layout == LAPACK_ROW_MAJOR ) { + lapack_int lda_t = MAX(1,n); + float* a_t = NULL; + /* Check leading dimension(s) */ + if( lda < n ) { + info = -5; + LAPACKE_xerbla( "LAPACKE_ssytrf_rk_work", info ); + return info; + } + /* Query optimal working array(s) size if requested */ + if( lwork == -1 ) { + LAPACK_ssytrf_rk( &uplo, &n, a, &lda_t, e, ipiv, work, &lwork, &info ); + return (info < 0) ? (info - 1) : 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; + } + /* Transpose input matrices */ + LAPACKE_ssy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + /* Call LAPACK function and adjust info */ + LAPACK_ssytrf_rk( &uplo, &n, a_t, &lda_t, e, ipiv, work, &lwork, &info ); + if( info < 0 ) { + info = info - 1; + } + /* Transpose output matrices */ + LAPACKE_ssy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + /* Release memory and exit */ + LAPACKE_free( a_t ); +exit_level_0: + if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_ssytrf_rk_work", info ); + } + } else { + info = -1; + LAPACKE_xerbla( "LAPACKE_ssytrf_rk_work", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_ssytri_3.c b/LAPACKE/src/lapacke_ssytri_3.c new file mode 100644 index 00000000..f68a8c42 --- /dev/null +++ b/LAPACKE/src/lapacke_ssytri_3.c @@ -0,0 +1,78 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native high-level C interface to LAPACK function ssytri_3 +* Author: Intel Corporation +* Generated November 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_ssytri_3( int matrix_layout, char uplo, lapack_int n, float* a, + lapack_int lda, const float* e, const lapack_int* ipiv ) +{ + lapack_int info = 0; + lapack_int lwork = -1; + float* work = NULL; + float work_query; + if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { + LAPACKE_xerbla( "LAPACKE_ssytri_3", -1 ); + return -1; + } +#ifndef LAPACK_DISABLE_NAN_CHECK + /* Optionally check input matrices for NaNs */ + if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + return -4; + } + if( LAPACKE_s_nancheck( n, e, 1 ) ) { + return -6; + } +#endif + /* Query optimal working array(s) size */ + info = LAPACKE_ssytri_3_work( matrix_layout, uplo, n, a, lda, e, ipiv, + &work_query, lwork ); + if( info != 0 ) { + goto exit_level_0; + } + lwork = (lapack_int)work_query; + /* Allocate memory for working array(s) */ + work = (float*)LAPACKE_malloc( sizeof(float) * lwork ); + if( work == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_0; + } + /* Call middle-level interface */ + info = LAPACKE_ssytri_3_work( matrix_layout, uplo, n, a, lda, e, ipiv, work, lwork); + /* Release memory and exit */ + LAPACKE_free( work ); +exit_level_0: + if( info == LAPACK_WORK_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_ssytri_3", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_ssytri_3_work.c b/LAPACKE/src/lapacke_ssytri_3_work.c new file mode 100644 index 00000000..ecaf253e --- /dev/null +++ b/LAPACKE/src/lapacke_ssytri_3_work.c @@ -0,0 +1,87 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native middle-level C interface to LAPACK function ssytri_3 +* Author: Intel Corporation +* Generated November 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_ssytri_3_work( int matrix_layout, char uplo, lapack_int n, + float* a, lapack_int lda, const float* e, + const lapack_int* ipiv, float* work, lapack_int lwork) +{ + lapack_int info = 0; + if( matrix_layout == LAPACK_COL_MAJOR ) { + /* Call LAPACK function and adjust info */ + LAPACK_ssytri_3( &uplo, &n, a, &lda, e, ipiv, work, &lwork, &info ); + if( info < 0 ) { + info = info - 1; + } + } else if( matrix_layout == LAPACK_ROW_MAJOR ) { + lapack_int lda_t = MAX(1,n); + float* a_t = NULL; + /* Check leading dimension(s) */ + if( lda < n ) { + info = -5; + LAPACKE_xerbla( "LAPACKE_ssytri_3_work", info ); + return info; + } + /* Query optimal working array(s) size if requested */ + if( lwork == -1 ) { + LAPACK_ssytri_3( &uplo, &n, a_t, &lda_t, e, ipiv, work, &lwork, &info ); + return (info < 0) ? (info - 1) : 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; + } + /* Transpose input matrices */ + LAPACKE_ssy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + /* Call LAPACK function and adjust info */ + LAPACK_ssytri_3( &uplo, &n, a_t, &lda_t, e, ipiv, work, &lwork, &info ); + if( info < 0 ) { + info = info - 1; + } + /* Transpose output matrices */ + LAPACKE_ssy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + /* Release memory and exit */ + LAPACKE_free( a_t ); +exit_level_0: + if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_ssytri_3_work", info ); + } + } else { + info = -1; + LAPACKE_xerbla( "LAPACKE_ssytri_3_work", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_ssytrs_3.c b/LAPACKE/src/lapacke_ssytrs_3.c new file mode 100644 index 00000000..d793b580 --- /dev/null +++ b/LAPACKE/src/lapacke_ssytrs_3.c @@ -0,0 +1,59 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native high-level C interface to LAPACK function ssytrs_3 +* Author: Intel Corporation +* Generated November 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_ssytrs_3( int matrix_layout, char uplo, lapack_int n, + lapack_int nrhs, const float* a, lapack_int lda, + const float* e, + const lapack_int* ipiv, float* b, lapack_int ldb ) +{ + if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { + LAPACKE_xerbla( "LAPACKE_ssytrs_3", -1 ); + return -1; + } +#ifndef LAPACK_DISABLE_NAN_CHECK + /* Optionally check input matrices for NaNs */ + if( LAPACKE_ssy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + return -5; + } + if( LAPACKE_s_nancheck( n, e ,1 ) ) { + return -7; + } + if( LAPACKE_sge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + return -9; + } +#endif + return LAPACKE_ssytrs_3_work( matrix_layout, uplo, n, nrhs, a, lda, + e, ipiv, b, ldb ); +} diff --git a/LAPACKE/src/lapacke_ssytrs_3_work.c b/LAPACKE/src/lapacke_ssytrs_3_work.c new file mode 100644 index 00000000..be351e76 --- /dev/null +++ b/LAPACKE/src/lapacke_ssytrs_3_work.c @@ -0,0 +1,99 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native middle-level C interface to LAPACK function ssytrs_3 +* Author: Intel Corporation +* Generated November 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_ssytrs_3_work( int matrix_layout, char uplo, lapack_int n, + lapack_int nrhs, const float* a, lapack_int lda, + const float* e, const lapack_int* ipiv, float* b, + lapack_int ldb ) +{ + lapack_int info = 0; + if( matrix_layout == LAPACK_COL_MAJOR ) { + /* Call LAPACK function and adjust info */ + LAPACK_ssytrs_3( &uplo, &n, &nrhs, a, &lda, e, ipiv, b, &ldb, &info ); + if( info < 0 ) { + info = info - 1; + } + } else if( matrix_layout == LAPACK_ROW_MAJOR ) { + lapack_int lda_t = MAX(1,n); + lapack_int ldb_t = MAX(1,n); + float* a_t = NULL; + float* b_t = NULL; + /* Check leading dimension(s) */ + if( lda < n ) { + info = -6; + LAPACKE_xerbla( "LAPACKE_ssytrs_3_work", info ); + return info; + } + if( ldb < nrhs ) { + info = -10; + LAPACKE_xerbla( "LAPACKE_ssytrs_3_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; + } + b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,nrhs) ); + if( b_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_1; + } + /* Transpose input matrices */ + LAPACKE_ssy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + LAPACKE_sge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + /* Call LAPACK function and adjust info */ + LAPACK_ssytrs_3( &uplo, &n, &nrhs, a_t, &lda_t, e, ipiv, b_t, &ldb_t, + &info ); + if( info < 0 ) { + info = info - 1; + } + /* Transpose output matrices */ + LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + /* Release memory and exit */ + LAPACKE_free( b_t ); +exit_level_1: + LAPACKE_free( a_t ); +exit_level_0: + if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_ssytrs_3_work", info ); + } + } else { + info = -1; + LAPACKE_xerbla( "LAPACKE_ssytrs_3_work", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_zgelq.c b/LAPACKE/src/lapacke_zgelq.c new file mode 100644 index 00000000..2aba1f5b --- /dev/null +++ b/LAPACKE/src/lapacke_zgelq.c @@ -0,0 +1,79 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native high-level C interface to LAPACK function zgelq +* Author: Intel Corporation +* Generated November 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_zgelq_work( int matrix_layout, lapack_int m, lapack_int n, + lapack_complex_double* a, lapack_int lda, + lapack_complex_double* t, lapack_int tsize ) +{ + lapack_int info = 0; + lapack_int lwork = -1; + lapack_complex_double* work = NULL; + lapack_complex_double work_query; + if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { + LAPACKE_xerbla( "LAPACKE_zgelq", -1 ); + return -1; + } +#ifndef LAPACK_DISABLE_NAN_CHECK + /* Optionally check input matrices for NaNs */ + if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) { + return -4; + } +#endif + /* Query optimal working array(s) size */ + info = LAPACKE_zgelq_work( matrix_layout, m, n, a, lda, t, tsize, &work_query, + lwork ); + if( info != 0 ) { + goto exit_level_0; + } + if( tsize == -1 || tsize == -2 ) { + goto exit_level_0; + } + lwork = (lapack_int)work_query; + /* Allocate memory for work arrays */ + work = (lapack_complex_double*)LAPACKE_malloc( sizeof(lapack_complex_double) * lwork ); + if( work == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_0; + } + /* Call middle-level interface */ + info = LAPACKE_zgelq_work( matrix_layout, m, n, a, lda, t, tsize, work, lwork ); + /* Release memory and exit */ + LAPACKE_free( work ); +exit_level_0: + if( info == LAPACK_WORK_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_zgelq", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_zgelq_work.c b/LAPACKE/src/lapacke_zgelq_work.c new file mode 100644 index 00000000..282b67d6 --- /dev/null +++ b/LAPACKE/src/lapacke_zgelq_work.c @@ -0,0 +1,88 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native middle-level C interface to LAPACK function zgelq +* Author: Intel Corporation +* Generated November 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_zgelq_work( int matrix_layout, lapack_int m, lapack_int n, + lapack_complex_double* a, lapack_int lda, + lapack_complex_double* t, lapack_int tsize, + lapack_complex_double* work, lapack_int lwork ) +{ + lapack_int info = 0; + if( matrix_layout == LAPACK_COL_MAJOR ) { + /* Call LAPACK function and adjust info */ + LAPACK_zgelq( &m, &n, a, &lda, t, &tsize, work, &lwork, &info ); + if( info < 0 ) { + info = info - 1; + } + } else if( matrix_layout == LAPACK_ROW_MAJOR ) { + lapack_int lda_t = MAX(1,m); + lapack_complex_double* a_t = NULL; + /* Check leading dimension(s) */ + if( lda < n ) { + info = -5; + LAPACKE_xerbla( "LAPACKE_zgelq_work", info ); + return info; + } + /* Query optimal working array(s) size if requested */ + if( tsize == -1 || tsize == -2 || lwork == -1 || lwork == -2) { + LAPACK_zgelq( &m, &n, a, &lda_t, t, &tsize, work, &lwork, &info ); + return (info < 0) ? (info - 1) : 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; + } + /* Transpose input matrices */ + LAPACKE_zge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + /* Call LAPACK function and adjust info */ + LAPACK_zgelq( &m, &n, a_t, &lda_t, t, &tsize, work, &lwork, &info ); + if( info < 0 ) { + info = info - 1; + } + /* Transpose output matrices */ + LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + /* Release memory and exit */ + LAPACKE_free( a_t ); +exit_level_0: + if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_zgelq_work", info ); + } + } else { + info = -1; + LAPACKE_xerbla( "LAPACKE_zgelq_work", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_zgemlq.c b/LAPACKE/src/lapacke_zgemlq.c new file mode 100644 index 00000000..355a0804 --- /dev/null +++ b/LAPACKE/src/lapacke_zgemlq.c @@ -0,0 +1,85 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native high-level C interface to LAPACK function zgemlq +* Author: Intel Corporation +* Generated November 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_zgemlq( int matrix_layout, char side, char trans, + lapack_int m, lapack_int n, lapack_int k, + const lapack_complex_double* a, lapack_int lda, + const lapack_complex_double* t, lapack_int tsize, + lapack_complex_double* c, lapack_int ldc ) +{ + lapack_int info = 0; + lapack_int lwork = -1; + lapack_complex_double* work = NULL; + lapack_complex_double work_query; + if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { + LAPACKE_xerbla( "LAPACKE_zgemlq", -1 ); + return -1; + } +#ifndef LAPACK_DISABLE_NAN_CHECK + /* Optionally check input matrices for NaNs */ + if( LAPACKE_zge_nancheck( matrix_layout, k, m, a, lda ) ) { + return -7; + } + if( LAPACKE_zge_nancheck( matrix_layout, m, n, c, ldc ) ) { + return -10; + } + if( LAPACKE_d_nancheck( tsize, t, 1 ) ) { + return -9; + } +#endif + /* Query optimal working array(s) size */ + info = LAPACKE_zgemlq_work( matrix_layout, side, trans, m, n, k, a, lda, + t, tsize, c, ldc, &work_query, lwork ); + if( info != 0 ) { + goto exit_level_0; + } + lwork = (lapack_int)work_query; + /* Allocate memory for work arrays */ + work = (lapack_complex_double*)LAPACKE_malloc( sizeof(lapack_complex_double) * lwork ); + if( work == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_0; + } + /* Call middle-level interface */ + info = LAPACKE_zgemlq_work( matrix_layout, side, trans, m, n, k, a, lda, + t, tsize, c, ldc, work, lwork ); + /* Release memory and exit */ + LAPACKE_free( work ); +exit_level_0: + if( info == LAPACK_WORK_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_zgemlq", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_zgemlq_work.c b/LAPACKE/src/lapacke_zgemlq_work.c new file mode 100644 index 00000000..d10e7306 --- /dev/null +++ b/LAPACKE/src/lapacke_zgemlq_work.c @@ -0,0 +1,114 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native middle-level C interface to LAPACK function zgemlq +* Author: Intel Corporation +* Generated June 2016 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_zgemlq_work( int matrix_layout, char side, char trans, + lapack_int m, lapack_int n, lapack_int k, + const lapack_complex_double* a, lapack_int lda, + const lapack_complex_double* t, lapack_int tsize, + lapack_complex_double* c, lapack_int ldc, + lapack_complex_double* work, lapack_int lwork ) +{ + lapack_int info = 0; + lapack_int r; + lapack_int lda_t, ldc_t; + lapack_complex_double *a_t = NULL, *c_t = NULL; + if( matrix_layout == LAPACK_COL_MAJOR ) { + /* Call LAPACK function and adjust info */ + LAPACK_zgemlq( &side, &trans, &m, &n, &k, a, &lda, t, &tsize, + c, &ldc, work, &lwork, &info ); + if( info < 0 ) { + info = info - 1; + } + } else if( matrix_layout == LAPACK_ROW_MAJOR ) { + r = LAPACKE_lsame( side, 'l' ) ? m : n; + lda_t = MAX(1,k); + ldc_t = MAX(1,m); + /* Check leading dimension(s) */ + if( lda < r ) { + info = -8; + LAPACKE_xerbla( "LAPACKE_zgemlq_work", info ); + return info; + } + if( ldc < n ) { + info = -11; + LAPACKE_xerbla( "LAPACKE_zgemlq_work", info ); + return info; + } + /* Query optimal working array(s) size if requested */ + if( lwork == -1 ) { + LAPACK_zgemlq( &side, &trans, &m, &n, &k, a, &lda_t, t, &tsize, + c, &ldc_t, work, &lwork, &info ); + return (info < 0) ? (info - 1) : info; + } + /* Allocate memory for temporary array(s) */ + if( LAPACKE_lsame( side, 'l' ) ) { + a_t = (lapack_complex_double*)LAPACKE_malloc( sizeof(lapack_complex_double) * lda_t * MAX(1,m) ); + } else { + 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; + } + c_t = (lapack_complex_double*)LAPACKE_malloc( sizeof(lapack_complex_double) * ldc_t * MAX(1,n) ); + if( c_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_1; + } + /* Transpose input matrices */ + LAPACKE_zge_trans( matrix_layout, k, m, a, lda, a_t, lda_t ); + LAPACKE_zge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t ); + /* Call LAPACK function and adjust info */ + LAPACK_zgemlq( &side, &trans, &m, &n, &k, a_t, &lda_t, t, &tsize, + c_t, &ldc_t, work, &lwork, &info ); + if( info < 0 ) { + info = info - 1; + } + /* Transpose output matrices */ + LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); + /* Release memory and exit */ + LAPACKE_free( c_t ); +exit_level_1: + LAPACKE_free( a_t ); +exit_level_0: + if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_zgemlq_work", info ); + } + } else { + info = -1; + LAPACKE_xerbla( "LAPACKE_zgemlq_work", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_zgemqr.c b/LAPACKE/src/lapacke_zgemqr.c new file mode 100644 index 00000000..07e1a7aa --- /dev/null +++ b/LAPACKE/src/lapacke_zgemqr.c @@ -0,0 +1,88 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native high-level C interface to LAPACK function zgemqr +* Author: Intel Corporation +* Generated December 2016 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_zgemqr( int matrix_layout, char side, char trans, + lapack_int m, lapack_int n, lapack_int k, + const lapack_complex_double* a, lapack_int lda, + const lapack_complex_double* t, lapack_int tsize, + lapack_complex_double* c, lapack_int ldc ) +{ + lapack_int info = 0; + lapack_int lwork = -1; + lapack_complex_double* work = NULL; + lapack_complex_double work_query; + lapack_int r; + if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { + LAPACKE_xerbla( "LAPACKE_zgemqr", -1 ); + return -1; + } +#ifndef LAPACK_DISABLE_NAN_CHECK + /* Optionally check input matrices for NaNs */ + r = LAPACKE_lsame( side, 'l' ) ? m : n; + if( LAPACKE_zge_nancheck( matrix_layout, r, k, a, lda ) ) { + return -7; + } + if( LAPACKE_zge_nancheck( matrix_layout, m, n, c, ldc ) ) { + return -10; + } + if( LAPACKE_z_nancheck( tsize, t, 1 ) ) { + return -9; + } +#endif + /* Query optimal working array(s) size */ + info = LAPACKE_zgemqr_work( matrix_layout, side, trans, m, n, k, a, lda, + t, tsize, c, ldc, &work_query, lwork ); + if( info != 0 ) { + goto exit_level_0; + } + lwork = LAPACK_Z2INT( work_query ); + /* Allocate memory for work arrays */ + work = (lapack_complex_double*) + LAPACKE_malloc( sizeof(lapack_complex_double) * lwork ); + if( work == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_0; + } + /* Call middle-level interface */ + info = LAPACKE_zgemqr_work( matrix_layout, side, trans, m, n, k, a, lda, + t, tsize, c, ldc, work, lwork ); + /* Release memory and exit */ + LAPACKE_free( work ); +exit_level_0: + if( info == LAPACK_WORK_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_zgemqr", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_zgemqr_work.c b/LAPACKE/src/lapacke_zgemqr_work.c new file mode 100644 index 00000000..f17fa84e --- /dev/null +++ b/LAPACKE/src/lapacke_zgemqr_work.c @@ -0,0 +1,112 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native middle-level C interface to LAPACK function zgemqr +* Author: Intel Corporation +* Generated December 2016 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_zgemqr_work( int matrix_layout, char side, char trans, + lapack_int m, lapack_int n, lapack_int k, + const lapack_complex_double* a, lapack_int lda, + const lapack_complex_double* t, lapack_int tsize, + lapack_complex_double* c, lapack_int ldc, + lapack_complex_double* work, lapack_int lwork ) +{ + lapack_int info = 0; + lapack_int r; + lapack_int lda_t, ldc_t; + lapack_complex_double *a_t = NULL, *c_t = NULL; + if( matrix_layout == LAPACK_COL_MAJOR ) { + /* Call LAPACK function and adjust info */ + LAPACK_zgemqr( &side, &trans, &m, &n, &k, a, &lda, t, &tsize, c, &ldc, + work, &lwork, &info ); + if( info < 0 ) { + info = info - 1; + } + } else if( matrix_layout == LAPACK_ROW_MAJOR ) { + r = LAPACKE_lsame( side, 'l' ) ? m : n; + lda_t = MAX(1,r); + ldc_t = MAX(1,m); + /* Check leading dimension(s) */ + if( lda < k ) { + info = -8; + LAPACKE_xerbla( "LAPACKE_zgemqr_work", info ); + return info; + } + if( ldc < n ) { + info = -11; + LAPACKE_xerbla( "LAPACKE_zgemqr_work", info ); + return info; + } + /* Query optimal working array(s) size if requested */ + if( lwork == -1 ) { + LAPACK_zgemqr( &side, &trans, &m, &n, &k, a, &lda_t, t, &tsize, + c, &ldc_t, work, &lwork, &info ); + return (info < 0) ? (info - 1) : info; + } + /* Allocate memory for temporary array(s) */ + a_t = (lapack_complex_double*) + LAPACKE_malloc( sizeof(lapack_complex_double) * lda_t * MAX(1,k) ); + if( a_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_0; + } + c_t = (lapack_complex_double*) + LAPACKE_malloc( sizeof(lapack_complex_double) * ldc_t * MAX(1,n) ); + if( c_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_1; + } + /* Transpose input matrices */ + LAPACKE_zge_trans( matrix_layout, r, k, a, lda, a_t, lda_t ); + LAPACKE_zge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t ); + /* Call LAPACK function and adjust info */ + LAPACK_zgemqr( &side, &trans, &m, &n, &k, a_t, &lda_t, t, &tsize, + c_t, &ldc_t, work, &lwork, &info ); + if( info < 0 ) { + info = info - 1; + } + /* Transpose output matrices */ + LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); + /* Release memory and exit */ + LAPACKE_free( c_t ); +exit_level_1: + LAPACKE_free( a_t ); +exit_level_0: + if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_zgemqr_work", info ); + } + } else { + info = -1; + LAPACKE_xerbla( "LAPACKE_zgemqr_work", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_zgeqr.c b/LAPACKE/src/lapacke_zgeqr.c new file mode 100644 index 00000000..61a179de --- /dev/null +++ b/LAPACKE/src/lapacke_zgeqr.c @@ -0,0 +1,80 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native high-level C interface to LAPACK function zgeqr +* Author: Intel Corporation +* Generated December 2016 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_zgeqr( int matrix_layout, lapack_int m, lapack_int n, + lapack_complex_double* a, lapack_int lda, + lapack_complex_double* t, lapack_int tsize ) +{ + lapack_int info = 0; + lapack_int lwork = -1; + lapack_complex_double* work = NULL; + lapack_complex_double work_query; + if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { + LAPACKE_xerbla( "LAPACKE_zgeqr", -1 ); + return -1; + } +#ifndef LAPACK_DISABLE_NAN_CHECK + /* Optionally check input matrices for NaNs */ + if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) { + return -4; + } +#endif + /* Query optimal working array(s) size */ + info = LAPACKE_zgeqr_work( matrix_layout, m, n, a, lda, t, tsize, &work_query, + lwork ); + if( info != 0 ) { + goto exit_level_0; + } + if( tsize == -1 || tsize == -2 ) { + goto exit_level_0; + } + lwork = (lapack_int)work_query; + /* Allocate memory for work arrays */ + work = (lapack_complex_double*) + LAPACKE_malloc( sizeof(lapack_complex_double) * lwork ); + if( work == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_0; + } + /* Call middle-level interface */ + info = LAPACKE_zgeqr_work( matrix_layout, m, n, a, lda, t, tsize, work, lwork ); + /* Release memory and exit */ + LAPACKE_free( work ); +exit_level_0: + if( info == LAPACK_WORK_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_zgeqr", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_zgeqr_work.c b/LAPACKE/src/lapacke_zgeqr_work.c new file mode 100644 index 00000000..304738b4 --- /dev/null +++ b/LAPACKE/src/lapacke_zgeqr_work.c @@ -0,0 +1,89 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native middle-level C interface to LAPACK function zgeqr +* Author: Intel Corporation +* Generated December 2016 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_zgeqr_work( int matrix_layout, lapack_int m, lapack_int n, + lapack_complex_double* a, lapack_int lda, + lapack_complex_double* t, lapack_int tsize, + lapack_complex_double* work, lapack_int lwork ) +{ + lapack_int info = 0; + if( matrix_layout == LAPACK_COL_MAJOR ) { + /* Call LAPACK function and adjust info */ + LAPACK_zgeqr( &m, &n, a, &lda, t, &tsize, work, &lwork, &info ); + if( info < 0 ) { + info = info - 1; + } + } else if( matrix_layout == LAPACK_ROW_MAJOR ) { + lapack_int lda_t = MAX(1,m); + lapack_complex_double* a_t = NULL; + /* Check leading dimension(s) */ + if( lda < n ) { + info = -5; + LAPACKE_xerbla( "LAPACKE_zgeqr_work", info ); + return info; + } + /* Query optimal working array(s) size if requested */ + if( tsize == -1 || tsize == -2 || lwork == -1 || lwork == -2) { + LAPACK_zgeqr( &m, &n, a, &lda_t, t, &tsize, work, &lwork, &info ); + return (info < 0) ? (info - 1) : 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; + } + /* Transpose input matrices */ + LAPACKE_zge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); + /* Call LAPACK function and adjust info */ + LAPACK_zgeqr( &m, &n, a_t, &lda_t, t, &tsize, work, &lwork, &info ); + if( info < 0 ) { + info = info - 1; + } + /* Transpose output matrices */ + LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); + /* Release memory and exit */ + LAPACKE_free( a_t ); +exit_level_0: + if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_zgeqr_work", info ); + } + } else { + info = -1; + LAPACKE_xerbla( "LAPACKE_zgeqr_work", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_zgetsls.c b/LAPACKE/src/lapacke_zgetsls.c new file mode 100644 index 00000000..6e73657d --- /dev/null +++ b/LAPACKE/src/lapacke_zgetsls.c @@ -0,0 +1,82 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native high-level C interface to LAPACK function zgetsls +* Author: Intel Corporation +* Generated December 2016 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_zgetsls( int matrix_layout, char trans, lapack_int m, + lapack_int n, lapack_int nrhs, + lapack_complex_double* a, lapack_int lda, + lapack_complex_double* b, lapack_int ldb ) +{ + lapack_int info = 0; + lapack_int lwork = -1; + lapack_complex_double* work = NULL; + lapack_complex_double work_query; + if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { + LAPACKE_xerbla( "LAPACKE_zgetsls", -1 ); + return -1; + } +#ifndef LAPACK_DISABLE_NAN_CHECK + /* Optionally check input matrices for NaNs */ + if( LAPACKE_zge_nancheck( matrix_layout, m, n, a, lda ) ) { + return -6; + } + if( LAPACKE_zge_nancheck( matrix_layout, MAX(m,n), nrhs, b, ldb ) ) { + return -8; + } +#endif + /* Query optimal working array(s) size */ + info = LAPACKE_zgetsls_work( matrix_layout, trans, m, n, nrhs, a, lda, b, ldb, + &work_query, lwork ); + if( info != 0 ) { + goto exit_level_0; + } + lwork = LAPACK_Z2INT( work_query ); + /* Allocate memory for work arrays */ + work = (lapack_complex_double*) + LAPACKE_malloc( sizeof(lapack_complex_double) * lwork ); + if( work == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_0; + } + /* Call middle-level interface */ + info = LAPACKE_zgetsls_work( matrix_layout, trans, m, n, nrhs, a, lda, b, ldb, + work, lwork ); + /* Release memory and exit */ + LAPACKE_free( work ); +exit_level_0: + if( info == LAPACK_WORK_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_zgetsls", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_zgetsls_work.c b/LAPACKE/src/lapacke_zgetsls_work.c new file mode 100644 index 00000000..dca7d49a --- /dev/null +++ b/LAPACKE/src/lapacke_zgetsls_work.c @@ -0,0 +1,112 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native middle-level C interface to LAPACK function zgetsls +* Author: Intel Corporation +* Generated December 2016 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_zgetsls_work( int matrix_layout, char trans, lapack_int m, + lapack_int n, lapack_int nrhs, + lapack_complex_double* a, lapack_int lda, + lapack_complex_double* b, lapack_int ldb, + lapack_complex_double* work, lapack_int lwork ) +{ + lapack_int info = 0; + if( matrix_layout == LAPACK_COL_MAJOR ) { + /* Call LAPACK function and adjust info */ + LAPACK_zgetsls( &trans, &m, &n, &nrhs, a, &lda, b, &ldb, work, &lwork, + &info ); + if( info < 0 ) { + info = info - 1; + } + } else if( matrix_layout == LAPACK_ROW_MAJOR ) { + lapack_int lda_t = MAX(1,m); + lapack_int ldb_t = MAX(1,MAX(m,n)); + lapack_complex_double* a_t = NULL; + lapack_complex_double* b_t = NULL; + /* Check leading dimension(s) */ + if( lda < n ) { + info = -7; + LAPACKE_xerbla( "LAPACKE_zgetsls_work", info ); + return info; + } + if( ldb < nrhs ) { + info = -9; + LAPACKE_xerbla( "LAPACKE_zgetsls_work", info ); + return info; + } + /* Query optimal working array(s) size if requested */ + if( lwork == -1 ) { + LAPACK_zgetsls( &trans, &m, &n, &nrhs, a, &lda_t, b, &ldb_t, work, + &lwork, &info ); + return (info < 0) ? (info - 1) : 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; + } + b_t = (lapack_complex_double*) + LAPACKE_malloc( sizeof(lapack_complex_double) * + ldb_t * MAX(1,nrhs) ); + if( b_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 ); + LAPACKE_zge_trans( matrix_layout, MAX(m,n), nrhs, b, ldb, b_t, ldb_t ); + /* Call LAPACK function and adjust info */ + LAPACK_zgetsls( &trans, &m, &n, &nrhs, a_t, &lda_t, b_t, &ldb_t, work, + &lwork, &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, MAX(m,n), nrhs, b_t, ldb_t, b, + ldb ); + /* Release memory and exit */ + LAPACKE_free( b_t ); +exit_level_1: + LAPACKE_free( a_t ); +exit_level_0: + if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_zgetsls_work", info ); + } + } else { + info = -1; + LAPACKE_xerbla( "LAPACKE_zgetsls_work", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_zhecon_3.c b/LAPACKE/src/lapacke_zhecon_3.c new file mode 100644 index 00000000..dd745685 --- /dev/null +++ b/LAPACKE/src/lapacke_zhecon_3.c @@ -0,0 +1,76 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native high-level C interface to LAPACK function zhecon_3 +* Author: Intel Corporation +* Generated November 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_zhecon_3( int matrix_layout, char uplo, lapack_int n, + const lapack_complex_double* a, lapack_int lda, + const lapack_complex_double* e, + const lapack_int* ipiv, double anorm, double* rcond ) +{ + lapack_int info = 0; + lapack_complex_double* work = NULL; + if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { + LAPACKE_xerbla( "LAPACKE_zhecon_3", -1 ); + return -1; + } +#ifndef LAPACK_DISABLE_NAN_CHECK + /* Optionally check input matrices for NaNs */ + if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) { + return -4; + } + if( LAPACKE_z_nancheck( n, e, 1 ) ) { + return -6; + } + if( LAPACKE_d_nancheck( 1, &anorm, 1 ) ) { + return -8; + } +#endif + /* Allocate memory for working array(s) */ + work = (lapack_complex_double*) + LAPACKE_malloc( sizeof(lapack_complex_double) * MAX(1,2*n) ); + if( work == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_0; + } + /* Call middle-level interface */ + info = LAPACKE_zhecon_3_work( matrix_layout, uplo, n, a, lda, e, ipiv, anorm, + rcond, work ); + /* Release memory and exit */ + LAPACKE_free( work ); +exit_level_0: + if( info == LAPACK_WORK_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_zhecon_3", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_zhecon_3_work.c b/LAPACKE/src/lapacke_zhecon_3_work.c new file mode 100644 index 00000000..47b78ebf --- /dev/null +++ b/LAPACKE/src/lapacke_zhecon_3_work.c @@ -0,0 +1,84 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native middle-level C interface to LAPACK function zhecon_3 +* Author: Intel Corporation +* Generated November 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_zhecon_3_work( int matrix_layout, char uplo, lapack_int n, + const lapack_complex_double* a, lapack_int lda, + const lapack_complex_double* e, + const lapack_int* ipiv, double anorm, + double* rcond, lapack_complex_double* work ) +{ + lapack_int info = 0; + if( matrix_layout == LAPACK_COL_MAJOR ) { + /* Call LAPACK function and adjust info */ + LAPACK_zhecon_3( &uplo, &n, a, &lda, e, ipiv, &anorm, rcond, work, &info ); + if( info < 0 ) { + info = info - 1; + } + } else if( matrix_layout == LAPACK_ROW_MAJOR ) { + lapack_int lda_t = MAX(1,n); + lapack_complex_double* a_t = NULL; + /* Check leading dimension(s) */ + if( lda < n ) { + info = -5; + LAPACKE_xerbla( "LAPACKE_zhecon_3_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; + } + /* Transpose input matrices */ + LAPACKE_zhe_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + /* Call LAPACK function and adjust info */ + LAPACK_zhecon_3( &uplo, &n, a_t, &lda_t, e, ipiv, &anorm, rcond, work, + &info ); + if( info < 0 ) { + info = info - 1; + } + /* Release memory and exit */ + LAPACKE_free( a_t ); +exit_level_0: + if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_zhecon_3_work", info ); + } + } else { + info = -1; + LAPACKE_xerbla( "LAPACKE_zhecon_3_work", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_zhesv_rk.c b/LAPACKE/src/lapacke_zhesv_rk.c new file mode 100644 index 00000000..e4fb4da6 --- /dev/null +++ b/LAPACKE/src/lapacke_zhesv_rk.c @@ -0,0 +1,85 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native high-level C interface to LAPACK function zhesv_rk +* Author: Intel Corporation +* Generated November 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_zhesv_rk( int matrix_layout, char uplo, lapack_int n, + lapack_int nrhs, lapack_complex_double* a, + lapack_int lda, lapack_complex_double* e, lapack_int* ipiv, + lapack_complex_double* b, lapack_int ldb ) +{ + lapack_int info = 0; + lapack_int lwork = -1; + lapack_complex_double* work = NULL; + lapack_complex_double work_query; + if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { + LAPACKE_xerbla( "LAPACKE_zhesv_rk", -1 ); + return -1; + } +#ifndef LAPACK_DISABLE_NAN_CHECK + /* Optionally check input matrices for NaNs */ + if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) { + return -5; + } + if( LAPACKE_z_nancheck( n, e, 1) ) { + return -7; + } + if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + return -9; + } +#endif + /* Query optimal working array(s) size */ + info = LAPACKE_zhesv_rk_work( matrix_layout, uplo, n, nrhs, a, lda, e, ipiv, b, + ldb, &work_query, lwork ); + if( info != 0 ) { + goto exit_level_0; + } + lwork = LAPACK_Z2INT( work_query ); + /* Allocate memory for work arrays */ + work = (lapack_complex_double*) + LAPACKE_malloc( sizeof(lapack_complex_double) * lwork ); + if( work == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_0; + } + /* Call middle-level interface */ + info = LAPACKE_zhesv_rk_work( matrix_layout, uplo, n, nrhs, a, lda, e, ipiv, b, + ldb, work, lwork ); + /* Release memory and exit */ + LAPACKE_free( work ); +exit_level_0: + if( info == LAPACK_WORK_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_zhesv_rk", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_zhesv_rk_work.c b/LAPACKE/src/lapacke_zhesv_rk_work.c new file mode 100644 index 00000000..391ce8b8 --- /dev/null +++ b/LAPACKE/src/lapacke_zhesv_rk_work.c @@ -0,0 +1,112 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native middle-level C interface to LAPACK function zhesv_rk +* Author: Intel Corporation +* Generated November 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_zhesv_rk_work( int matrix_layout, char uplo, lapack_int n, + lapack_int nrhs, lapack_complex_double* a, + lapack_int lda, lapack_complex_double* e, + lapack_int* ipiv, + lapack_complex_double* b, lapack_int ldb, + lapack_complex_double* work, lapack_int lwork ) +{ + lapack_int info = 0; + if( matrix_layout == LAPACK_COL_MAJOR ) { + /* Call LAPACK function and adjust info */ + LAPACK_zhesv_rk( &uplo, &n, &nrhs, a, &lda, e, ipiv, b, &ldb, work, &lwork, + &info ); + if( info < 0 ) { + info = info - 1; + } + } else if( matrix_layout == LAPACK_ROW_MAJOR ) { + lapack_int lda_t = MAX(1,n); + lapack_int ldb_t = MAX(1,n); + lapack_complex_double* a_t = NULL; + lapack_complex_double* b_t = NULL; + /* Check leading dimension(s) */ + if( lda < n ) { + info = -6; + LAPACKE_xerbla( "LAPACKE_zhesv_rk_work", info ); + return info; + } + if( ldb < nrhs ) { + info = -10; + LAPACKE_xerbla( "LAPACKE_zhesv_rk_work", info ); + return info; + } + /* Query optimal working array(s) size if requested */ + if( lwork == -1 ) { + LAPACK_zhesv_rk( &uplo, &n, &nrhs, a, &lda_t, e, ipiv, b, &ldb_t, work, + &lwork, &info ); + return (info < 0) ? (info - 1) : 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; + } + b_t = (lapack_complex_double*) + LAPACKE_malloc( sizeof(lapack_complex_double) * + ldb_t * MAX(1,nrhs) ); + if( b_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_1; + } + /* Transpose input matrices */ + LAPACKE_zhe_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + /* Call LAPACK function and adjust info */ + LAPACK_zhesv_rk( &uplo, &n, &nrhs, a_t, &lda_t, e, ipiv, b_t, &ldb_t, work, + &lwork, &info ); + if( info < 0 ) { + info = info - 1; + } + /* Transpose output matrices */ + LAPACKE_zhe_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + /* Release memory and exit */ + LAPACKE_free( b_t ); +exit_level_1: + LAPACKE_free( a_t ); +exit_level_0: + if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_zhesv_rk_work", info ); + } + } else { + info = -1; + LAPACKE_xerbla( "LAPACKE_zhesv_rk_work", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_zhetrf_rk.c b/LAPACKE/src/lapacke_zhetrf_rk.c new file mode 100644 index 00000000..87d0cc84 --- /dev/null +++ b/LAPACKE/src/lapacke_zhetrf_rk.c @@ -0,0 +1,81 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native high-level C interface to LAPACK function zhetrf_rk +* Author: Intel Corporation +* Generated November 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_zhetrf_rk( int matrix_layout, char uplo, lapack_int n, + lapack_complex_double* a, lapack_int lda, + lapack_complex_double* e, lapack_int* ipiv ) +{ + lapack_int info = 0; + lapack_int lwork = -1; + lapack_complex_double* work = NULL; + lapack_complex_double work_query; + if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { + LAPACKE_xerbla( "LAPACKE_zhetrf_rk", -1 ); + return -1; + } +#ifndef LAPACK_DISABLE_NAN_CHECK + /* Optionally check input matrices for NaNs */ + if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) { + return -4; + } + if( LAPACKE_z_nancheck( n, e, 1 ) ) { + return -6; + } +#endif + /* Query optimal working array(s) size */ + info = LAPACKE_zhetrf_rk_work( matrix_layout, uplo, n, a, lda, e, ipiv, + &work_query, lwork ); + if( info != 0 ) { + goto exit_level_0; + } + lwork = LAPACK_Z2INT( work_query ); + /* Allocate memory for work arrays */ + work = (lapack_complex_double*) + LAPACKE_malloc( sizeof(lapack_complex_double) * lwork ); + if( work == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_0; + } + /* Call middle-level interface */ + info = LAPACKE_zhetrf_rk_work( matrix_layout, uplo, n, a, lda, e, ipiv, work, + lwork ); + /* Release memory and exit */ + LAPACKE_free( work ); +exit_level_0: + if( info == LAPACK_WORK_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_zhetrf_rk", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_zhetrf_rk_work.c b/LAPACKE/src/lapacke_zhetrf_rk_work.c new file mode 100644 index 00000000..90794654 --- /dev/null +++ b/LAPACKE/src/lapacke_zhetrf_rk_work.c @@ -0,0 +1,90 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native middle-level C interface to LAPACK function zhetrf_rk +* Author: Intel Corporation +* Generated November 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_zhetrf_rk_work( int matrix_layout, char uplo, lapack_int n, + lapack_complex_double* a, lapack_int lda, + lapack_complex_double* e, + lapack_int* ipiv, lapack_complex_double* work, + lapack_int lwork ) +{ + lapack_int info = 0; + if( matrix_layout == LAPACK_COL_MAJOR ) { + /* Call LAPACK function and adjust info */ + LAPACK_zhetrf_rk( &uplo, &n, a, &lda, e, ipiv, work, &lwork, &info ); + if( info < 0 ) { + info = info - 1; + } + } else if( matrix_layout == LAPACK_ROW_MAJOR ) { + lapack_int lda_t = MAX(1,n); + lapack_complex_double* a_t = NULL; + /* Check leading dimension(s) */ + if( lda < n ) { + info = -5; + LAPACKE_xerbla( "LAPACKE_zhetrf_rk_work", info ); + return info; + } + /* Query optimal working array(s) size if requested */ + if( lwork == -1 ) { + LAPACK_zhetrf_rk( &uplo, &n, a, &lda_t, e, ipiv, work, &lwork, &info ); + return (info < 0) ? (info - 1) : 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; + } + /* Transpose input matrices */ + LAPACKE_zhe_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + /* Call LAPACK function and adjust info */ + LAPACK_zhetrf_rk( &uplo, &n, a_t, &lda_t, e, ipiv, work, &lwork, &info ); + if( info < 0 ) { + info = info - 1; + } + /* Transpose output matrices */ + LAPACKE_zhe_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + /* Release memory and exit */ + LAPACKE_free( a_t ); +exit_level_0: + if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_zhetrf_rk_work", info ); + } + } else { + info = -1; + LAPACKE_xerbla( "LAPACKE_zhetrf_rk_work", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_zhetri_3.c b/LAPACKE/src/lapacke_zhetri_3.c new file mode 100644 index 00000000..cb01a1c8 --- /dev/null +++ b/LAPACKE/src/lapacke_zhetri_3.c @@ -0,0 +1,80 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native high-level C interface to LAPACK function zhetri_3 +* Author: Intel Corporation +* Generated November 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_zhetri_3( int matrix_layout, char uplo, lapack_int n, + lapack_complex_double* a, lapack_int lda, + const lapack_complex_double* e, const lapack_int* ipiv ) +{ + lapack_int info = 0; + lapack_int lwork = -1; + lapack_complex_double* work = NULL; + lapack_complex_double work_query; + if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { + LAPACKE_xerbla( "LAPACKE_zhetri_3", -1 ); + return -1; + } +#ifndef LAPACK_DISABLE_NAN_CHECK + /* Optionally check input matrices for NaNs */ + if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) { + return -4; + } + if( LAPACKE_z_nancheck( n, e, 1 ) ) { + return -6; + } +#endif + /* Query optimal working array(s) size */ + info = LAPACKE_zhetri_3_work( matrix_layout, uplo, n, a, lda, e, ipiv, + &work_query, lwork ); + if( info != 0 ) { + goto exit_level_0; + } + lwork = (lapack_int)work_query; + /* Allocate memory for working array(s) */ + work = (lapack_complex_double*) + LAPACKE_malloc( sizeof(lapack_complex_double) * lwork ); + if( work == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_0; + } + /* Call middle-level interface */ + info = LAPACKE_zhetri_3_work( matrix_layout, uplo, n, a, lda, e, ipiv, work, lwork ); + /* Release memory and exit */ + LAPACKE_free( work ); +exit_level_0: + if( info == LAPACK_WORK_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_zhetri_3", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_zhetri_3_work.c b/LAPACKE/src/lapacke_zhetri_3_work.c new file mode 100644 index 00000000..cf94a2c4 --- /dev/null +++ b/LAPACKE/src/lapacke_zhetri_3_work.c @@ -0,0 +1,89 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native middle-level C interface to LAPACK function zhetri_3 +* Author: Intel Corporation +* Generated November 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_zhetri_3_work( int matrix_layout, char uplo, lapack_int n, + lapack_complex_double* a, lapack_int lda, + const lapack_complex_double* e, const lapack_int* ipiv, + lapack_complex_double* work, lapack_int lwork) +{ + lapack_int info = 0; + if( matrix_layout == LAPACK_COL_MAJOR ) { + /* Call LAPACK function and adjust info */ + LAPACK_zhetri_3( &uplo, &n, a, &lda, e, ipiv, work, &lwork, &info ); + if( info < 0 ) { + info = info - 1; + } + } else if( matrix_layout == LAPACK_ROW_MAJOR ) { + lapack_int lda_t = MAX(1,n); + lapack_complex_double* a_t = NULL; + /* Check leading dimension(s) */ + if( lda < n ) { + info = -5; + LAPACKE_xerbla( "LAPACKE_zhetri_3_work", info ); + return info; + } + /* Query optimal working array(s) size if requested */ + if( lwork == -1 ) { + LAPACK_zhetri_3( &uplo, &n, a_t, &lda_t, e, ipiv, work, &lwork, &info ); + return (info < 0) ? (info - 1) : 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; + } + /* Transpose input matrices */ + LAPACKE_zhe_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + /* Call LAPACK function and adjust info */ + LAPACK_zhetri_3( &uplo, &n, a_t, &lda_t, e, ipiv, work, &lwork, &info ); + if( info < 0 ) { + info = info - 1; + } + /* Transpose output matrices */ + LAPACKE_zhe_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + /* Release memory and exit */ + LAPACKE_free( a_t ); +exit_level_0: + if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_zhetri_3_work", info ); + } + } else { + info = -1; + LAPACKE_xerbla( "LAPACKE_zhetri_3_work", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_zhetrs_3.c b/LAPACKE/src/lapacke_zhetrs_3.c new file mode 100644 index 00000000..21ef49aa --- /dev/null +++ b/LAPACKE/src/lapacke_zhetrs_3.c @@ -0,0 +1,60 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native high-level C interface to LAPACK function zhetrs_3 +* Author: Intel Corporation +* Generated November 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_zhetrs_3( int matrix_layout, char uplo, lapack_int n, + lapack_int nrhs, const lapack_complex_double* a, + lapack_int lda, const lapack_complex_double* e, + const lapack_int* ipiv, + lapack_complex_double* b, lapack_int ldb ) +{ + if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { + LAPACKE_xerbla( "LAPACKE_zhetrs_3", -1 ); + return -1; + } +#ifndef LAPACK_DISABLE_NAN_CHECK + /* Optionally check input matrices for NaNs */ + if( LAPACKE_zhe_nancheck( matrix_layout, uplo, n, a, lda ) ) { + return -5; + } + if( LAPACKE_z_nancheck( n, e ,1 ) ) { + return -7; + } + if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + return -9; + } +#endif + return LAPACKE_zhetrs_3_work( matrix_layout, uplo, n, nrhs, a, lda, + e, ipiv, b, ldb ); +} diff --git a/LAPACKE/src/lapacke_zhetrs_3_work.c b/LAPACKE/src/lapacke_zhetrs_3_work.c new file mode 100644 index 00000000..0f9dd8f1 --- /dev/null +++ b/LAPACKE/src/lapacke_zhetrs_3_work.c @@ -0,0 +1,103 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native middle-level C interface to LAPACK function zhetrs_3 +* Author: Intel Corporation +* Generated November 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_zhetrs_3_work( int matrix_layout, char uplo, lapack_int n, + lapack_int nrhs, const lapack_complex_double* a, + lapack_int lda, const lapack_complex_double* e, + const lapack_int* ipiv, + lapack_complex_double* b, lapack_int ldb ) +{ + lapack_int info = 0; + if( matrix_layout == LAPACK_COL_MAJOR ) { + /* Call LAPACK function and adjust info */ + LAPACK_zhetrs_3( &uplo, &n, &nrhs, a, &lda, e, ipiv, b, &ldb, &info ); + if( info < 0 ) { + info = info - 1; + } + } else if( matrix_layout == LAPACK_ROW_MAJOR ) { + lapack_int lda_t = MAX(1,n); + lapack_int ldb_t = MAX(1,n); + lapack_complex_double* a_t = NULL; + lapack_complex_double* b_t = NULL; + /* Check leading dimension(s) */ + if( lda < n ) { + info = -6; + LAPACKE_xerbla( "LAPACKE_zhetrs_3_work", info ); + return info; + } + if( ldb < nrhs ) { + info = -10; + LAPACKE_xerbla( "LAPACKE_zhetrs_3_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; + } + b_t = (lapack_complex_double*) + LAPACKE_malloc( sizeof(lapack_complex_double) * + ldb_t * MAX(1,nrhs) ); + if( b_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_1; + } + /* Transpose input matrices */ + LAPACKE_zhe_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + /* Call LAPACK function and adjust info */ + LAPACK_zhetrs_3( &uplo, &n, &nrhs, a_t, &lda_t, e, ipiv, b_t, &ldb_t, + &info ); + if( info < 0 ) { + info = info - 1; + } + /* Transpose output matrices */ + LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + /* Release memory and exit */ + LAPACKE_free( b_t ); +exit_level_1: + LAPACKE_free( a_t ); +exit_level_0: + if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_zhetrs_3_work", info ); + } + } else { + info = -1; + LAPACKE_xerbla( "LAPACKE_zhetrs_3_work", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_zsycon_3.c b/LAPACKE/src/lapacke_zsycon_3.c new file mode 100644 index 00000000..8868b292 --- /dev/null +++ b/LAPACKE/src/lapacke_zsycon_3.c @@ -0,0 +1,76 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native high-level C interface to LAPACK function zsycon_3 +* Author: Intel Corporation +* Generated November 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_zsycon_3( int matrix_layout, char uplo, lapack_int n, + const lapack_complex_double* a, lapack_int lda, + const lapack_complex_double* e, + const lapack_int* ipiv, double anorm, double* rcond ) +{ + lapack_int info = 0; + lapack_complex_double* work = NULL; + if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { + LAPACKE_xerbla( "LAPACKE_zsycon_3", -1 ); + return -1; + } +#ifndef LAPACK_DISABLE_NAN_CHECK + /* Optionally check input matrices for NaNs */ + if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + return -4; + } + if( LAPACKE_z_nancheck( n, e, 1 ) ) { + return -6; + } + if( LAPACKE_d_nancheck( 1, &anorm, 1 ) ) { + return -8; + } +#endif + /* Allocate memory for working array(s) */ + work = (lapack_complex_double*) + LAPACKE_malloc( sizeof(lapack_complex_double) * MAX(1,2*n) ); + if( work == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_0; + } + /* Call middle-level interface */ + info = LAPACKE_zsycon_3_work( matrix_layout, uplo, n, a, lda, e, ipiv, anorm, + rcond, work ); + /* Release memory and exit */ + LAPACKE_free( work ); +exit_level_0: + if( info == LAPACK_WORK_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_zsycon_3", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_zsycon_3_work.c b/LAPACKE/src/lapacke_zsycon_3_work.c new file mode 100644 index 00000000..8b30cb82 --- /dev/null +++ b/LAPACKE/src/lapacke_zsycon_3_work.c @@ -0,0 +1,84 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native middle-level C interface to LAPACK function zsycon_3 +* Author: Intel Corporation +* Generated November 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_zsycon_3_work( int matrix_layout, char uplo, lapack_int n, + const lapack_complex_double* a, lapack_int lda, + const lapack_complex_double* e, + const lapack_int* ipiv, double anorm, + double* rcond, lapack_complex_double* work ) +{ + lapack_int info = 0; + if( matrix_layout == LAPACK_COL_MAJOR ) { + /* Call LAPACK function and adjust info */ + LAPACK_zsycon_3( &uplo, &n, a, &lda, e, ipiv, &anorm, rcond, work, &info ); + if( info < 0 ) { + info = info - 1; + } + } else if( matrix_layout == LAPACK_ROW_MAJOR ) { + lapack_int lda_t = MAX(1,n); + lapack_complex_double* a_t = NULL; + /* Check leading dimension(s) */ + if( lda < n ) { + info = -5; + LAPACKE_xerbla( "LAPACKE_zsycon_3_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; + } + /* Transpose input matrices */ + LAPACKE_zsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + /* Call LAPACK function and adjust info */ + LAPACK_zsycon_3( &uplo, &n, a_t, &lda_t, e, ipiv, &anorm, rcond, work, + &info ); + if( info < 0 ) { + info = info - 1; + } + /* Release memory and exit */ + LAPACKE_free( a_t ); +exit_level_0: + if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_zsycon_3_work", info ); + } + } else { + info = -1; + LAPACKE_xerbla( "LAPACKE_zsycon_3_work", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_zsysv_rk.c b/LAPACKE/src/lapacke_zsysv_rk.c new file mode 100644 index 00000000..cbe58e61 --- /dev/null +++ b/LAPACKE/src/lapacke_zsysv_rk.c @@ -0,0 +1,85 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native high-level C interface to LAPACK function zsysv_rk +* Author: Intel Corporation +* Generated November 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_zsysv_rk( int matrix_layout, char uplo, lapack_int n, + lapack_int nrhs, lapack_complex_double* a, + lapack_int lda, lapack_complex_double* e, lapack_int* ipiv, + lapack_complex_double* b, lapack_int ldb ) +{ + lapack_int info = 0; + lapack_int lwork = -1; + lapack_complex_double* work = NULL; + lapack_complex_double work_query; + if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { + LAPACKE_xerbla( "LAPACKE_zsysv_rk", -1 ); + return -1; + } +#ifndef LAPACK_DISABLE_NAN_CHECK + /* Optionally check input matrices for NaNs */ + if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + return -5; + } + if( LAPACKE_z_nancheck( n, e, 1) ) { + return -7; + } + if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + return -9; + } +#endif + /* Query optimal working array(s) size */ + info = LAPACKE_zsysv_rk_work( matrix_layout, uplo, n, nrhs, a, lda, e, ipiv, b, + ldb, &work_query, lwork ); + if( info != 0 ) { + goto exit_level_0; + } + lwork = LAPACK_Z2INT( work_query ); + /* Allocate memory for work arrays */ + work = (lapack_complex_double*) + LAPACKE_malloc( sizeof(lapack_complex_double) * lwork ); + if( work == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_0; + } + /* Call middle-level interface */ + info = LAPACKE_zsysv_rk_work( matrix_layout, uplo, n, nrhs, a, lda, e, ipiv, b, + ldb, work, lwork ); + /* Release memory and exit */ + LAPACKE_free( work ); +exit_level_0: + if( info == LAPACK_WORK_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_zsysv_rk", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_zsysv_rk_work.c b/LAPACKE/src/lapacke_zsysv_rk_work.c new file mode 100644 index 00000000..17c9365b --- /dev/null +++ b/LAPACKE/src/lapacke_zsysv_rk_work.c @@ -0,0 +1,112 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native middle-level C interface to LAPACK function zsysv_rk +* Author: Intel Corporation +* Generated November 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_zsysv_rk_work( int matrix_layout, char uplo, lapack_int n, + lapack_int nrhs, lapack_complex_double* a, + lapack_int lda, lapack_complex_double* e, + lapack_int* ipiv, + lapack_complex_double* b, lapack_int ldb, + lapack_complex_double* work, lapack_int lwork ) +{ + lapack_int info = 0; + if( matrix_layout == LAPACK_COL_MAJOR ) { + /* Call LAPACK function and adjust info */ + LAPACK_zsysv_rk( &uplo, &n, &nrhs, a, &lda, e, ipiv, b, &ldb, work, &lwork, + &info ); + if( info < 0 ) { + info = info - 1; + } + } else if( matrix_layout == LAPACK_ROW_MAJOR ) { + lapack_int lda_t = MAX(1,n); + lapack_int ldb_t = MAX(1,n); + lapack_complex_double* a_t = NULL; + lapack_complex_double* b_t = NULL; + /* Check leading dimension(s) */ + if( lda < n ) { + info = -6; + LAPACKE_xerbla( "LAPACKE_zsysv_rk_work", info ); + return info; + } + if( ldb < nrhs ) { + info = -10; + LAPACKE_xerbla( "LAPACKE_zsysv_rk_work", info ); + return info; + } + /* Query optimal working array(s) size if requested */ + if( lwork == -1 ) { + LAPACK_zsysv_rk( &uplo, &n, &nrhs, a, &lda_t, e, ipiv, b, &ldb_t, work, + &lwork, &info ); + return (info < 0) ? (info - 1) : 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; + } + b_t = (lapack_complex_double*) + LAPACKE_malloc( sizeof(lapack_complex_double) * + ldb_t * MAX(1,nrhs) ); + if( b_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_1; + } + /* Transpose input matrices */ + LAPACKE_zsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + /* Call LAPACK function and adjust info */ + LAPACK_zsysv_rk( &uplo, &n, &nrhs, a_t, &lda_t, e, ipiv, b_t, &ldb_t, work, + &lwork, &info ); + if( info < 0 ) { + info = info - 1; + } + /* Transpose output matrices */ + LAPACKE_zsy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + /* Release memory and exit */ + LAPACKE_free( b_t ); +exit_level_1: + LAPACKE_free( a_t ); +exit_level_0: + if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_zsysv_rk_work", info ); + } + } else { + info = -1; + LAPACKE_xerbla( "LAPACKE_zsysv_rk_work", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_zsytrf_rk.c b/LAPACKE/src/lapacke_zsytrf_rk.c new file mode 100644 index 00000000..cc0efcea --- /dev/null +++ b/LAPACKE/src/lapacke_zsytrf_rk.c @@ -0,0 +1,81 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native high-level C interface to LAPACK function zsytrf_rk +* Author: Intel Corporation +* Generated November 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_zsytrf_rk( int matrix_layout, char uplo, lapack_int n, + lapack_complex_double* a, lapack_int lda, + lapack_complex_double* e, lapack_int* ipiv ) +{ + lapack_int info = 0; + lapack_int lwork = -1; + lapack_complex_double* work = NULL; + lapack_complex_double work_query; + if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { + LAPACKE_xerbla( "LAPACKE_zsytrf_rk", -1 ); + return -1; + } +#ifndef LAPACK_DISABLE_NAN_CHECK + /* Optionally check input matrices for NaNs */ + if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + return -4; + } + if( LAPACKE_z_nancheck( n, e, 1 ) ) { + return -6; + } +#endif + /* Query optimal working array(s) size */ + info = LAPACKE_zsytrf_rk_work( matrix_layout, uplo, n, a, lda, e, ipiv, + &work_query, lwork ); + if( info != 0 ) { + goto exit_level_0; + } + lwork = LAPACK_Z2INT( work_query ); + /* Allocate memory for work arrays */ + work = (lapack_complex_double*) + LAPACKE_malloc( sizeof(lapack_complex_double) * lwork ); + if( work == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_0; + } + /* Call middle-level interface */ + info = LAPACKE_zsytrf_rk_work( matrix_layout, uplo, n, a, lda, e, ipiv, work, + lwork ); + /* Release memory and exit */ + LAPACKE_free( work ); +exit_level_0: + if( info == LAPACK_WORK_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_zsytrf_rk", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_zsytrf_rk_work.c b/LAPACKE/src/lapacke_zsytrf_rk_work.c new file mode 100644 index 00000000..02e032c9 --- /dev/null +++ b/LAPACKE/src/lapacke_zsytrf_rk_work.c @@ -0,0 +1,89 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native middle-level C interface to LAPACK function zsytrf_rk +* Author: Intel Corporation +* Generated November 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_zsytrf_rk_work( int matrix_layout, char uplo, lapack_int n, + lapack_complex_double* a, lapack_int lda, + lapack_complex_double* e, lapack_int* ipiv, lapack_complex_double* work, + lapack_int lwork ) +{ + lapack_int info = 0; + if( matrix_layout == LAPACK_COL_MAJOR ) { + /* Call LAPACK function and adjust info */ + LAPACK_zsytrf_rk( &uplo, &n, a, &lda, e, ipiv, work, &lwork, &info ); + if( info < 0 ) { + info = info - 1; + } + } else if( matrix_layout == LAPACK_ROW_MAJOR ) { + lapack_int lda_t = MAX(1,n); + lapack_complex_double* a_t = NULL; + /* Check leading dimension(s) */ + if( lda < n ) { + info = -5; + LAPACKE_xerbla( "LAPACKE_zsytrf_rk_work", info ); + return info; + } + /* Query optimal working array(s) size if requested */ + if( lwork == -1 ) { + LAPACK_zsytrf_rk( &uplo, &n, a, &lda_t, e, ipiv, work, &lwork, &info ); + return (info < 0) ? (info - 1) : 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; + } + /* Transpose input matrices */ + LAPACKE_zsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + /* Call LAPACK function and adjust info */ + LAPACK_zsytrf_rk( &uplo, &n, a_t, &lda_t, e, ipiv, work, &lwork, &info ); + if( info < 0 ) { + info = info - 1; + } + /* Transpose output matrices */ + LAPACKE_zsy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + /* Release memory and exit */ + LAPACKE_free( a_t ); +exit_level_0: + if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_zsytrf_rk_work", info ); + } + } else { + info = -1; + LAPACKE_xerbla( "LAPACKE_zsytrf_rk_work", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_zsytri_3.c b/LAPACKE/src/lapacke_zsytri_3.c new file mode 100644 index 00000000..1ace4819 --- /dev/null +++ b/LAPACKE/src/lapacke_zsytri_3.c @@ -0,0 +1,80 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native high-level C interface to LAPACK function zsytri_3 +* Author: Intel Corporation +* Generated November 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_zsytri_3( int matrix_layout, char uplo, lapack_int n, + lapack_complex_double* a, lapack_int lda, + const lapack_complex_double* e, const lapack_int* ipiv ) +{ + lapack_int info = 0; + lapack_int lwork = -1; + lapack_complex_double* work = NULL; + lapack_complex_double work_query; + if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { + LAPACKE_xerbla( "LAPACKE_zsytri_3", -1 ); + return -1; + } +#ifndef LAPACK_DISABLE_NAN_CHECK + /* Optionally check input matrices for NaNs */ + if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + return -4; + } + if( LAPACKE_z_nancheck( n, e, 1 ) ) { + return -6; + } +#endif + /* Query optimal working array(s) size */ + info = LAPACKE_zsytri_3_work( matrix_layout, uplo, n, a, lda, e, ipiv, + &work_query, lwork ); + if( info != 0 ) { + goto exit_level_0; + } + lwork = (lapack_int)work_query; + /* Allocate memory for working array(s) */ + work = (lapack_complex_double*) + LAPACKE_malloc( sizeof(lapack_complex_double) * lwork ); + if( work == NULL ) { + info = LAPACK_WORK_MEMORY_ERROR; + goto exit_level_0; + } + /* Call middle-level interface */ + info = LAPACKE_zsytri_3_work( matrix_layout, uplo, n, a, lda, e, ipiv, work, lwork ); + /* Release memory and exit */ + LAPACKE_free( work ); +exit_level_0: + if( info == LAPACK_WORK_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_zsytri_3", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_zsytri_3_work.c b/LAPACKE/src/lapacke_zsytri_3_work.c new file mode 100644 index 00000000..39438c68 --- /dev/null +++ b/LAPACKE/src/lapacke_zsytri_3_work.c @@ -0,0 +1,89 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native middle-level C interface to LAPACK function zsytri_3 +* Author: Intel Corporation +* Generated November 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_zsytri_3_work( int matrix_layout, char uplo, lapack_int n, + lapack_complex_double* a, lapack_int lda, + const lapack_complex_double* e, const lapack_int* ipiv, + lapack_complex_double* work, lapack_int lwork) +{ + lapack_int info = 0; + if( matrix_layout == LAPACK_COL_MAJOR ) { + /* Call LAPACK function and adjust info */ + LAPACK_zsytri_3( &uplo, &n, a, &lda, e, ipiv, work, &lwork, &info ); + if( info < 0 ) { + info = info - 1; + } + } else if( matrix_layout == LAPACK_ROW_MAJOR ) { + lapack_int lda_t = MAX(1,n); + lapack_complex_double* a_t = NULL; + /* Check leading dimension(s) */ + if( lda < n ) { + info = -5; + LAPACKE_xerbla( "LAPACKE_zsytri_3_work", info ); + return info; + } + /* Query optimal working array(s) size if requested */ + if( lwork == -1 ) { + LAPACK_zsytri_3( &uplo, &n, a_t, &lda_t, e, ipiv, work, &lwork, &info ); + return (info < 0) ? (info - 1) : 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; + } + /* Transpose input matrices */ + LAPACKE_zsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + /* Call LAPACK function and adjust info */ + LAPACK_zsytri_3( &uplo, &n, a_t, &lda_t, e, ipiv, work, &lwork, &info ); + if( info < 0 ) { + info = info - 1; + } + /* Transpose output matrices */ + LAPACKE_zsy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); + /* Release memory and exit */ + LAPACKE_free( a_t ); +exit_level_0: + if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_zsytri_3_work", info ); + } + } else { + info = -1; + LAPACKE_xerbla( "LAPACKE_zsytri_3_work", info ); + } + return info; +} diff --git a/LAPACKE/src/lapacke_zsytrs_3.c b/LAPACKE/src/lapacke_zsytrs_3.c new file mode 100644 index 00000000..b73d3daf --- /dev/null +++ b/LAPACKE/src/lapacke_zsytrs_3.c @@ -0,0 +1,60 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native high-level C interface to LAPACK function zsytrs_3 +* Author: Intel Corporation +* Generated November 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_zsytrs_3( int matrix_layout, char uplo, lapack_int n, + lapack_int nrhs, const lapack_complex_double* a, + lapack_int lda, const lapack_complex_double* e, + const lapack_int* ipiv, lapack_complex_double* b, + lapack_int ldb ) +{ + if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { + LAPACKE_xerbla( "LAPACKE_zsytrs_3", -1 ); + return -1; + } +#ifndef LAPACK_DISABLE_NAN_CHECK + /* Optionally check input matrices for NaNs */ + if( LAPACKE_zsy_nancheck( matrix_layout, uplo, n, a, lda ) ) { + return -5; + } + if( LAPACKE_z_nancheck( n, e ,1 ) ) { + return -7; + } + if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { + return -9; + } +#endif + return LAPACKE_zsytrs_3_work( matrix_layout, uplo, n, nrhs, a, lda, + e, ipiv, b, ldb ); +} diff --git a/LAPACKE/src/lapacke_zsytrs_3_work.c b/LAPACKE/src/lapacke_zsytrs_3_work.c new file mode 100644 index 00000000..518e3946 --- /dev/null +++ b/LAPACKE/src/lapacke_zsytrs_3_work.c @@ -0,0 +1,103 @@ +/***************************************************************************** + Copyright (c) 2014, Intel Corp. + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of Intel Corporation nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE + LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF + THE POSSIBILITY OF SUCH DAMAGE. +***************************************************************************** +* Contents: Native middle-level C interface to LAPACK function zsytrs_3 +* Author: Intel Corporation +* Generated November 2015 +*****************************************************************************/ + +#include "lapacke_utils.h" + +lapack_int LAPACKE_zsytrs_3_work( int matrix_layout, char uplo, lapack_int n, + lapack_int nrhs, const lapack_complex_double* a, + lapack_int lda, const lapack_complex_double* e, + const lapack_int* ipiv, + lapack_complex_double* b, lapack_int ldb ) +{ + lapack_int info = 0; + if( matrix_layout == LAPACK_COL_MAJOR ) { + /* Call LAPACK function and adjust info */ + LAPACK_zsytrs_3( &uplo, &n, &nrhs, a, &lda, e, ipiv, b, &ldb, &info ); + if( info < 0 ) { + info = info - 1; + } + } else if( matrix_layout == LAPACK_ROW_MAJOR ) { + lapack_int lda_t = MAX(1,n); + lapack_int ldb_t = MAX(1,n); + lapack_complex_double* a_t = NULL; + lapack_complex_double* b_t = NULL; + /* Check leading dimension(s) */ + if( lda < n ) { + info = -6; + LAPACKE_xerbla( "LAPACKE_zsytrs_3_work", info ); + return info; + } + if( ldb < nrhs ) { + info = -10; + LAPACKE_xerbla( "LAPACKE_zsytrs_3_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; + } + b_t = (lapack_complex_double*) + LAPACKE_malloc( sizeof(lapack_complex_double) * + ldb_t * MAX(1,nrhs) ); + if( b_t == NULL ) { + info = LAPACK_TRANSPOSE_MEMORY_ERROR; + goto exit_level_1; + } + /* Transpose input matrices */ + LAPACKE_zsy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); + LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); + /* Call LAPACK function and adjust info */ + LAPACK_zsytrs_3( &uplo, &n, &nrhs, a_t, &lda_t, e, ipiv, b_t, &ldb_t, + &info ); + if( info < 0 ) { + info = info - 1; + } + /* Transpose output matrices */ + LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); + /* Release memory and exit */ + LAPACKE_free( b_t ); +exit_level_1: + LAPACKE_free( a_t ); +exit_level_0: + if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { + LAPACKE_xerbla( "LAPACKE_zsytrs_3_work", info ); + } + } else { + info = -1; + LAPACKE_xerbla( "LAPACKE_zsytrs_3_work", info ); + } + return info; +} diff --git a/SRC/chb2st_kernels.f b/SRC/chb2st_kernels.f index 8b0a4b28..9e08a275 100644 --- a/SRC/chb2st_kernels.f +++ b/SRC/chb2st_kernels.f @@ -1,6 +1,6 @@ *> \brief \b CHB2ST_KERNELS * -* @generated from zhb2st_kernels.f, fortran z -> c, Sun Nov 6 19:34:06 2016 +* @generated from zhb2st_kernels.f, fortran z -> c, Wed Dec 7 08:22:40 2016 * * =========== DOCUMENTATION =========== * @@ -128,7 +128,7 @@ * IMPLICIT NONE * -* -- LAPACK computational routine (version 3.4.0) -- +* -- LAPACK computational routine (version 3.7.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * November 2016 @@ -181,9 +181,9 @@ * * Upper case -* +* IF( UPPER ) THEN -* +* IF( WANTZ ) THEN VPOS = MOD( SWEEP-1, 2 ) * N + ST TAUPOS = MOD( SWEEP-1, 2 ) * N + ST @@ -191,59 +191,67 @@ VPOS = MOD( SWEEP-1, 2 ) * N + ST TAUPOS = MOD( SWEEP-1, 2 ) * N + ST ENDIF - GO TO ( 101, 102, 103 ) TTYPE -* - 101 CONTINUE - LM = ED - ST + 1 -* - V( VPOS ) = ONE - DO 10 I = 1, LM-1 - V( VPOS+I ) = CONJG( A( OFDPOS-I, ST+I ) ) - A( OFDPOS-I, ST+I ) = ZERO - 10 CONTINUE - CTMP = CONJG( A( OFDPOS, ST ) ) - CALL CLARFG( LM, CTMP, V( VPOS+1 ), 1, - $ TAU( TAUPOS ) ) - A( OFDPOS, ST ) = CTMP -* - 103 CONTINUE - LM = ED - ST + 1 - CALL CLARFY( UPLO, LM, V( VPOS ), 1, CONJG( TAU( TAUPOS ) ), - $ A( DPOS, ST ), LDA-1, WORK) - GOTO 300 -* - 102 CONTINUE - J1 = ED+1 - J2 = MIN( ED+NB, N ) - LN = ED-ST+1 - LM = J2-J1+1 - IF( LM.GT.0) THEN - CALL CLARFX( 'Left', LN, LM, V( VPOS ), - $ CONJG( TAU( TAUPOS ) ), A( DPOS-NB, J1 ), - $ LDA-1, WORK) -* - IF( WANTZ ) THEN - VPOS = MOD( SWEEP-1, 2 ) * N + J1 - TAUPOS = MOD( SWEEP-1, 2 ) * N + J1 - ELSE - VPOS = MOD( SWEEP-1, 2 ) * N + J1 - TAUPOS = MOD( SWEEP-1, 2 ) * N + J1 - ENDIF +* + IF( TTYPE.EQ.1 ) THEN + LM = ED - ST + 1 * V( VPOS ) = ONE - DO 30 I = 1, LM-1 - V( VPOS+I ) = CONJG( A( DPOS-NB-I, J1+I ) ) - A( DPOS-NB-I, J1+I ) = ZERO - 30 CONTINUE - CTMP = CONJG( A( DPOS-NB, J1 ) ) - CALL CLARFG( LM, CTMP, V( VPOS+1 ), 1, TAU( TAUPOS ) ) - A( DPOS-NB, J1 ) = CTMP -* - CALL CLARFX( 'Right', LN-1, LM, V( VPOS ), - $ TAU( TAUPOS ), - $ A( DPOS-NB+1, J1 ), LDA-1, WORK) + DO 10 I = 1, LM-1 + V( VPOS+I ) = CONJG( A( OFDPOS-I, ST+I ) ) + A( OFDPOS-I, ST+I ) = ZERO + 10 CONTINUE + CTMP = CONJG( A( OFDPOS, ST ) ) + CALL CLARFG( LM, CTMP, V( VPOS+1 ), 1, + $ TAU( TAUPOS ) ) + A( OFDPOS, ST ) = CTMP +* + LM = ED - ST + 1 + CALL CLARFY( UPLO, LM, V( VPOS ), 1, + $ CONJG( TAU( TAUPOS ) ), + $ A( DPOS, ST ), LDA-1, WORK) + ENDIF +* + IF( TTYPE.EQ.3 ) THEN +* + LM = ED - ST + 1 + CALL CLARFY( UPLO, LM, V( VPOS ), 1, + $ CONJG( TAU( TAUPOS ) ), + $ A( DPOS, ST ), LDA-1, WORK) + ENDIF +* + IF( TTYPE.EQ.2 ) THEN + J1 = ED+1 + J2 = MIN( ED+NB, N ) + LN = ED-ST+1 + LM = J2-J1+1 + IF( LM.GT.0) THEN + CALL CLARFX( 'Left', LN, LM, V( VPOS ), + $ CONJG( TAU( TAUPOS ) ), + $ A( DPOS-NB, J1 ), LDA-1, WORK) +* + IF( WANTZ ) THEN + VPOS = MOD( SWEEP-1, 2 ) * N + J1 + TAUPOS = MOD( SWEEP-1, 2 ) * N + J1 + ELSE + VPOS = MOD( SWEEP-1, 2 ) * N + J1 + TAUPOS = MOD( SWEEP-1, 2 ) * N + J1 + ENDIF +* + V( VPOS ) = ONE + DO 30 I = 1, LM-1 + V( VPOS+I ) = + $ CONJG( A( DPOS-NB-I, J1+I ) ) + A( DPOS-NB-I, J1+I ) = ZERO + 30 CONTINUE + CTMP = CONJG( A( DPOS-NB, J1 ) ) + CALL CLARFG( LM, CTMP, V( VPOS+1 ), 1, TAU( TAUPOS ) ) + A( DPOS-NB, J1 ) = CTMP +* + CALL CLARFX( 'Right', LN-1, LM, V( VPOS ), + $ TAU( TAUPOS ), + $ A( DPOS-NB+1, J1 ), LDA-1, WORK) + ENDIF ENDIF - GOTO 300 * * Lower case * @@ -256,63 +264,70 @@ VPOS = MOD( SWEEP-1, 2 ) * N + ST TAUPOS = MOD( SWEEP-1, 2 ) * N + ST ENDIF - GO TO ( 201, 202, 203 ) TTYPE -* - 201 CONTINUE - LM = ED - ST + 1 -* - V( VPOS ) = ONE - DO 20 I = 1, LM-1 - V( VPOS+I ) = A( OFDPOS+I, ST-1 ) - A( OFDPOS+I, ST-1 ) = ZERO - 20 CONTINUE - CALL CLARFG( LM, A( OFDPOS, ST-1 ), V( VPOS+1 ), 1, - $ TAU( TAUPOS ) ) -* - 203 CONTINUE - LM = ED - ST + 1 -* - CALL CLARFY( UPLO, LM, V( VPOS ), 1, CONJG( TAU( TAUPOS ) ), - $ A( DPOS, ST ), LDA-1, WORK) - - GOTO 300 -* - 202 CONTINUE - J1 = ED+1 - J2 = MIN( ED+NB, N ) - LN = ED-ST+1 - LM = J2-J1+1 -* - IF( LM.GT.0) THEN - CALL CLARFX( 'Right', LM, LN, V( VPOS ), - $ TAU( TAUPOS ), A( DPOS+NB, ST ), - $ LDA-1, WORK) -* - IF( WANTZ ) THEN - VPOS = MOD( SWEEP-1, 2 ) * N + J1 - TAUPOS = MOD( SWEEP-1, 2 ) * N + J1 - ELSE - VPOS = MOD( SWEEP-1, 2 ) * N + J1 - TAUPOS = MOD( SWEEP-1, 2 ) * N + J1 - ENDIF -* +* + IF( TTYPE.EQ.1 ) THEN + LM = ED - ST + 1 +* V( VPOS ) = ONE - DO 40 I = 1, LM-1 - V( VPOS+I ) = A( DPOS+NB+I, ST ) - A( DPOS+NB+I, ST ) = ZERO - 40 CONTINUE - CALL CLARFG( LM, A( DPOS+NB, ST ), V( VPOS+1 ), 1, - $ TAU( TAUPOS ) ) -* - CALL CLARFX( 'Left', LM, LN-1, V( VPOS ), + DO 20 I = 1, LM-1 + V( VPOS+I ) = A( OFDPOS+I, ST-1 ) + A( OFDPOS+I, ST-1 ) = ZERO + 20 CONTINUE + CALL CLARFG( LM, A( OFDPOS, ST-1 ), V( VPOS+1 ), 1, + $ TAU( TAUPOS ) ) +* + LM = ED - ST + 1 +* + CALL CLARFY( UPLO, LM, V( VPOS ), 1, $ CONJG( TAU( TAUPOS ) ), - $ A( DPOS+NB-1, ST+1 ), LDA-1, WORK) + $ A( DPOS, ST ), LDA-1, WORK) ENDIF - GOTO 300 - ENDIF +* + IF( TTYPE.EQ.3 ) THEN + LM = ED - ST + 1 +* + CALL CLARFY( UPLO, LM, V( VPOS ), 1, + $ CONJG( TAU( TAUPOS ) ), + $ A( DPOS, ST ), LDA-1, WORK) - 300 CONTINUE + ENDIF +* + IF( TTYPE.EQ.2 ) THEN + J1 = ED+1 + J2 = MIN( ED+NB, N ) + LN = ED-ST+1 + LM = J2-J1+1 +* + IF( LM.GT.0) THEN + CALL CLARFX( 'Right', LM, LN, V( VPOS ), + $ TAU( TAUPOS ), A( DPOS+NB, ST ), + $ LDA-1, WORK) +* + IF( WANTZ ) THEN + VPOS = MOD( SWEEP-1, 2 ) * N + J1 + TAUPOS = MOD( SWEEP-1, 2 ) * N + J1 + ELSE + VPOS = MOD( SWEEP-1, 2 ) * N + J1 + TAUPOS = MOD( SWEEP-1, 2 ) * N + J1 + ENDIF +* + V( VPOS ) = ONE + DO 40 I = 1, LM-1 + V( VPOS+I ) = A( DPOS+NB+I, ST ) + A( DPOS+NB+I, ST ) = ZERO + 40 CONTINUE + CALL CLARFG( LM, A( DPOS+NB, ST ), V( VPOS+1 ), 1, + $ TAU( TAUPOS ) ) +* + CALL CLARFX( 'Left', LM, LN-1, V( VPOS ), + $ CONJG( TAU( TAUPOS ) ), + $ A( DPOS+NB-1, ST+1 ), LDA-1, WORK) + + ENDIF + ENDIF + ENDIF +* RETURN * * END OF CHB2ST_KERNELS diff --git a/SRC/chetrd_hb2st.F b/SRC/chetrd_hb2st.F index c4d44803..85bffa08 100644 --- a/SRC/chetrd_hb2st.F +++ b/SRC/chetrd_hb2st.F @@ -334,8 +334,9 @@ * Quick return if possible * IF( N.EQ.0 ) THEN - WORK( 1 ) = 1 - RETURN + HOUS( 1 ) = 1 + WORK( 1 ) = 1 + RETURN END IF * * Determine pointer position @@ -382,7 +383,10 @@ DO 40 I = 1, N-1 E( I ) = RZERO 40 CONTINUE - RETURN +* + HOUS( 1 ) = 1 + WORK( 1 ) = 1 + RETURN END IF * * Case KD=1: @@ -437,6 +441,9 @@ C CALL CSCAL( N, TMP, Q( 1, I+1 ), 1 ) C END IF 70 CONTINUE ENDIF +* + HOUS( 1 ) = 1 + WORK( 1 ) = 1 RETURN END IF * @@ -473,7 +480,7 @@ C END IF THED = MIN( (STT + THGRSIZ -1), (N-1)) DO 110 I = STT, N-1 ED = MIN( I, THED ) - IF( STT.GT.ED ) GOTO 100 + IF( STT.GT.ED ) EXIT DO 120 M = 1, STEPERCOL ST = STT DO 130 SWEEPID = ST, ED @@ -537,7 +544,7 @@ C END IF #endif IF ( BLKLASTIND.GE.(N-1) ) THEN STT = STT + 1 - GOTO 130 + EXIT ENDIF 140 CONTINUE 130 CONTINUE diff --git a/SRC/chetrd_he2hb.f b/SRC/chetrd_he2hb.f index 28f5dc60..c6be3459 100644 --- a/SRC/chetrd_he2hb.f +++ b/SRC/chetrd_he2hb.f @@ -1,6 +1,6 @@ *> \brief \b CHETRD_HE2HB * -* @generated from zhetrd_he2hb.f, fortran z -> c, Sun Nov 6 19:34:06 2016 +* @generated from zhetrd_he2hb.f, fortran z -> c, Wed Dec 7 08:22:40 2016 * * =========== DOCUMENTATION =========== * @@ -245,7 +245,7 @@ * IMPLICIT NONE * -* -- LAPACK computational routine (version 3.4.0) -- +* -- LAPACK computational routine (version 3.7.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * November 2016 diff --git a/SRC/dgejsv.f b/SRC/dgejsv.f index 64f0908f..4369e331 100644 --- a/SRC/dgejsv.f +++ b/SRC/dgejsv.f @@ -562,7 +562,7 @@ ELSE IF ( LSVEC .AND. ( LDU .LT. M ) ) THEN INFO = - 13 ELSE IF ( RSVEC .AND. ( LDV .LT. N ) ) THEN - INFO = - 14 + INFO = - 15 ELSE IF ( (.NOT.(LSVEC .OR. RSVEC .OR. ERREST).AND. & (LWORK .LT. MAX(7,4*N+1,2*M+N))) .OR. & (.NOT.(LSVEC .OR. RSVEC) .AND. ERREST .AND. diff --git a/SRC/dsb2st_kernels.f b/SRC/dsb2st_kernels.f index 15d1186e..1eab415d 100644 --- a/SRC/dsb2st_kernels.f +++ b/SRC/dsb2st_kernels.f @@ -1,6 +1,6 @@ *> \brief \b DSB2ST_KERNELS * -* @generated from zhb2st_kernels.f, fortran z -> d, Sun Nov 6 19:34:06 2016 +* @generated from zhb2st_kernels.f, fortran z -> d, Wed Dec 7 08:22:39 2016 * * =========== DOCUMENTATION =========== * @@ -128,7 +128,7 @@ * IMPLICIT NONE * -* -- LAPACK computational routine (version 3.4.0) -- +* -- LAPACK computational routine (version 3.7.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * November 2016 @@ -181,9 +181,9 @@ * * Upper case -* +* IF( UPPER ) THEN -* +* IF( WANTZ ) THEN VPOS = MOD( SWEEP-1, 2 ) * N + ST TAUPOS = MOD( SWEEP-1, 2 ) * N + ST @@ -191,59 +191,67 @@ VPOS = MOD( SWEEP-1, 2 ) * N + ST TAUPOS = MOD( SWEEP-1, 2 ) * N + ST ENDIF - GO TO ( 101, 102, 103 ) TTYPE -* - 101 CONTINUE - LM = ED - ST + 1 -* - V( VPOS ) = ONE - DO 10 I = 1, LM-1 - V( VPOS+I ) = ( A( OFDPOS-I, ST+I ) ) - A( OFDPOS-I, ST+I ) = ZERO - 10 CONTINUE - CTMP = ( A( OFDPOS, ST ) ) - CALL DLARFG( LM, CTMP, V( VPOS+1 ), 1, - $ TAU( TAUPOS ) ) - A( OFDPOS, ST ) = CTMP -* - 103 CONTINUE - LM = ED - ST + 1 - CALL DLARFY( UPLO, LM, V( VPOS ), 1, ( TAU( TAUPOS ) ), - $ A( DPOS, ST ), LDA-1, WORK) - GOTO 300 -* - 102 CONTINUE - J1 = ED+1 - J2 = MIN( ED+NB, N ) - LN = ED-ST+1 - LM = J2-J1+1 - IF( LM.GT.0) THEN - CALL DLARFX( 'Left', LN, LM, V( VPOS ), - $ ( TAU( TAUPOS ) ), A( DPOS-NB, J1 ), - $ LDA-1, WORK) -* - IF( WANTZ ) THEN - VPOS = MOD( SWEEP-1, 2 ) * N + J1 - TAUPOS = MOD( SWEEP-1, 2 ) * N + J1 - ELSE - VPOS = MOD( SWEEP-1, 2 ) * N + J1 - TAUPOS = MOD( SWEEP-1, 2 ) * N + J1 - ENDIF +* + IF( TTYPE.EQ.1 ) THEN + LM = ED - ST + 1 * V( VPOS ) = ONE - DO 30 I = 1, LM-1 - V( VPOS+I ) = ( A( DPOS-NB-I, J1+I ) ) - A( DPOS-NB-I, J1+I ) = ZERO - 30 CONTINUE - CTMP = ( A( DPOS-NB, J1 ) ) - CALL DLARFG( LM, CTMP, V( VPOS+1 ), 1, TAU( TAUPOS ) ) - A( DPOS-NB, J1 ) = CTMP -* - CALL DLARFX( 'Right', LN-1, LM, V( VPOS ), - $ TAU( TAUPOS ), - $ A( DPOS-NB+1, J1 ), LDA-1, WORK) + DO 10 I = 1, LM-1 + V( VPOS+I ) = ( A( OFDPOS-I, ST+I ) ) + A( OFDPOS-I, ST+I ) = ZERO + 10 CONTINUE + CTMP = ( A( OFDPOS, ST ) ) + CALL DLARFG( LM, CTMP, V( VPOS+1 ), 1, + $ TAU( TAUPOS ) ) + A( OFDPOS, ST ) = CTMP +* + LM = ED - ST + 1 + CALL DLARFY( UPLO, LM, V( VPOS ), 1, + $ ( TAU( TAUPOS ) ), + $ A( DPOS, ST ), LDA-1, WORK) + ENDIF +* + IF( TTYPE.EQ.3 ) THEN +* + LM = ED - ST + 1 + CALL DLARFY( UPLO, LM, V( VPOS ), 1, + $ ( TAU( TAUPOS ) ), + $ A( DPOS, ST ), LDA-1, WORK) + ENDIF +* + IF( TTYPE.EQ.2 ) THEN + J1 = ED+1 + J2 = MIN( ED+NB, N ) + LN = ED-ST+1 + LM = J2-J1+1 + IF( LM.GT.0) THEN + CALL DLARFX( 'Left', LN, LM, V( VPOS ), + $ ( TAU( TAUPOS ) ), + $ A( DPOS-NB, J1 ), LDA-1, WORK) +* + IF( WANTZ ) THEN + VPOS = MOD( SWEEP-1, 2 ) * N + J1 + TAUPOS = MOD( SWEEP-1, 2 ) * N + J1 + ELSE + VPOS = MOD( SWEEP-1, 2 ) * N + J1 + TAUPOS = MOD( SWEEP-1, 2 ) * N + J1 + ENDIF +* + V( VPOS ) = ONE + DO 30 I = 1, LM-1 + V( VPOS+I ) = + $ ( A( DPOS-NB-I, J1+I ) ) + A( DPOS-NB-I, J1+I ) = ZERO + 30 CONTINUE + CTMP = ( A( DPOS-NB, J1 ) ) + CALL DLARFG( LM, CTMP, V( VPOS+1 ), 1, TAU( TAUPOS ) ) + A( DPOS-NB, J1 ) = CTMP +* + CALL DLARFX( 'Right', LN-1, LM, V( VPOS ), + $ TAU( TAUPOS ), + $ A( DPOS-NB+1, J1 ), LDA-1, WORK) + ENDIF ENDIF - GOTO 300 * * Lower case * @@ -256,63 +264,70 @@ VPOS = MOD( SWEEP-1, 2 ) * N + ST TAUPOS = MOD( SWEEP-1, 2 ) * N + ST ENDIF - GO TO ( 201, 202, 203 ) TTYPE -* - 201 CONTINUE - LM = ED - ST + 1 -* - V( VPOS ) = ONE - DO 20 I = 1, LM-1 - V( VPOS+I ) = A( OFDPOS+I, ST-1 ) - A( OFDPOS+I, ST-1 ) = ZERO - 20 CONTINUE - CALL DLARFG( LM, A( OFDPOS, ST-1 ), V( VPOS+1 ), 1, - $ TAU( TAUPOS ) ) -* - 203 CONTINUE - LM = ED - ST + 1 -* - CALL DLARFY( UPLO, LM, V( VPOS ), 1, ( TAU( TAUPOS ) ), - $ A( DPOS, ST ), LDA-1, WORK) - - GOTO 300 -* - 202 CONTINUE - J1 = ED+1 - J2 = MIN( ED+NB, N ) - LN = ED-ST+1 - LM = J2-J1+1 -* - IF( LM.GT.0) THEN - CALL DLARFX( 'Right', LM, LN, V( VPOS ), - $ TAU( TAUPOS ), A( DPOS+NB, ST ), - $ LDA-1, WORK) -* - IF( WANTZ ) THEN - VPOS = MOD( SWEEP-1, 2 ) * N + J1 - TAUPOS = MOD( SWEEP-1, 2 ) * N + J1 - ELSE - VPOS = MOD( SWEEP-1, 2 ) * N + J1 - TAUPOS = MOD( SWEEP-1, 2 ) * N + J1 - ENDIF -* +* + IF( TTYPE.EQ.1 ) THEN + LM = ED - ST + 1 +* V( VPOS ) = ONE - DO 40 I = 1, LM-1 - V( VPOS+I ) = A( DPOS+NB+I, ST ) - A( DPOS+NB+I, ST ) = ZERO - 40 CONTINUE - CALL DLARFG( LM, A( DPOS+NB, ST ), V( VPOS+1 ), 1, - $ TAU( TAUPOS ) ) -* - CALL DLARFX( 'Left', LM, LN-1, V( VPOS ), + DO 20 I = 1, LM-1 + V( VPOS+I ) = A( OFDPOS+I, ST-1 ) + A( OFDPOS+I, ST-1 ) = ZERO + 20 CONTINUE + CALL DLARFG( LM, A( OFDPOS, ST-1 ), V( VPOS+1 ), 1, + $ TAU( TAUPOS ) ) +* + LM = ED - ST + 1 +* + CALL DLARFY( UPLO, LM, V( VPOS ), 1, $ ( TAU( TAUPOS ) ), - $ A( DPOS+NB-1, ST+1 ), LDA-1, WORK) + $ A( DPOS, ST ), LDA-1, WORK) ENDIF - GOTO 300 - ENDIF +* + IF( TTYPE.EQ.3 ) THEN + LM = ED - ST + 1 +* + CALL DLARFY( UPLO, LM, V( VPOS ), 1, + $ ( TAU( TAUPOS ) ), + $ A( DPOS, ST ), LDA-1, WORK) - 300 CONTINUE + ENDIF +* + IF( TTYPE.EQ.2 ) THEN + J1 = ED+1 + J2 = MIN( ED+NB, N ) + LN = ED-ST+1 + LM = J2-J1+1 +* + IF( LM.GT.0) THEN + CALL DLARFX( 'Right', LM, LN, V( VPOS ), + $ TAU( TAUPOS ), A( DPOS+NB, ST ), + $ LDA-1, WORK) +* + IF( WANTZ ) THEN + VPOS = MOD( SWEEP-1, 2 ) * N + J1 + TAUPOS = MOD( SWEEP-1, 2 ) * N + J1 + ELSE + VPOS = MOD( SWEEP-1, 2 ) * N + J1 + TAUPOS = MOD( SWEEP-1, 2 ) * N + J1 + ENDIF +* + V( VPOS ) = ONE + DO 40 I = 1, LM-1 + V( VPOS+I ) = A( DPOS+NB+I, ST ) + A( DPOS+NB+I, ST ) = ZERO + 40 CONTINUE + CALL DLARFG( LM, A( DPOS+NB, ST ), V( VPOS+1 ), 1, + $ TAU( TAUPOS ) ) +* + CALL DLARFX( 'Left', LM, LN-1, V( VPOS ), + $ ( TAU( TAUPOS ) ), + $ A( DPOS+NB-1, ST+1 ), LDA-1, WORK) + + ENDIF + ENDIF + ENDIF +* RETURN * * END OF DSB2ST_KERNELS diff --git a/SRC/dsytrd_sb2st.F b/SRC/dsytrd_sb2st.F index 6925b525..7b5abc93 100644 --- a/SRC/dsytrd_sb2st.F +++ b/SRC/dsytrd_sb2st.F @@ -331,8 +331,9 @@ * Quick return if possible * IF( N.EQ.0 ) THEN - WORK( 1 ) = 1 - RETURN + HOUS( 1 ) = 1 + WORK( 1 ) = 1 + RETURN END IF * * Determine pointer position @@ -379,7 +380,10 @@ DO 40 I = 1, N-1 E( I ) = RZERO 40 CONTINUE - RETURN +* + HOUS( 1 ) = 1 + WORK( 1 ) = 1 + RETURN END IF * * Case KD=1: @@ -406,6 +410,9 @@ E( I ) = ( AB( ABOFDPOS, I ) ) 70 CONTINUE ENDIF +* + HOUS( 1 ) = 1 + WORK( 1 ) = 1 RETURN END IF * @@ -442,7 +449,7 @@ THED = MIN( (STT + THGRSIZ -1), (N-1)) DO 110 I = STT, N-1 ED = MIN( I, THED ) - IF( STT.GT.ED ) GOTO 100 + IF( STT.GT.ED ) EXIT DO 120 M = 1, STEPERCOL ST = STT DO 130 SWEEPID = ST, ED @@ -506,7 +513,7 @@ #endif IF ( BLKLASTIND.GE.(N-1) ) THEN STT = STT + 1 - GOTO 130 + EXIT ENDIF 140 CONTINUE 130 CONTINUE diff --git a/SRC/dsytrd_sy2sb.f b/SRC/dsytrd_sy2sb.f index 8f0261df..e6e3fa46 100644 --- a/SRC/dsytrd_sy2sb.f +++ b/SRC/dsytrd_sy2sb.f @@ -1,6 +1,6 @@ *> \brief \b DSYTRD_SY2SB * -* @generated from zhetrd_he2hb.f, fortran z -> d, Sun Nov 6 19:34:06 2016 +* @generated from zhetrd_he2hb.f, fortran z -> d, Wed Dec 7 08:22:39 2016 * * =========== DOCUMENTATION =========== * @@ -245,7 +245,7 @@ * IMPLICIT NONE * -* -- LAPACK computational routine (version 3.4.0) -- +* -- LAPACK computational routine (version 3.7.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * November 2016 diff --git a/SRC/sgejsv.f b/SRC/sgejsv.f index a52e39b3..a26c4a63 100644 --- a/SRC/sgejsv.f +++ b/SRC/sgejsv.f @@ -562,7 +562,7 @@ ELSE IF ( LSVEC .AND. ( LDU .LT. M ) ) THEN INFO = - 13 ELSE IF ( RSVEC .AND. ( LDV .LT. N ) ) THEN - INFO = - 14 + INFO = - 15 ELSE IF ( (.NOT.(LSVEC .OR. RSVEC .OR. ERREST).AND. $ (LWORK .LT. MAX(7,4*N+1,2*M+N))) .OR. $ (.NOT.(LSVEC .OR. RSVEC) .AND. ERREST .AND. diff --git a/SRC/ssb2st_kernels.f b/SRC/ssb2st_kernels.f index 60058dda..75de2dff 100644 --- a/SRC/ssb2st_kernels.f +++ b/SRC/ssb2st_kernels.f @@ -1,6 +1,6 @@ *> \brief \b SSB2ST_KERNELS * -* @generated from zhb2st_kernels.f, fortran z -> s, Sun Nov 6 19:34:06 2016 +* @generated from zhb2st_kernels.f, fortran z -> s, Wed Dec 7 08:22:40 2016 * * =========== DOCUMENTATION =========== * @@ -128,7 +128,7 @@ * IMPLICIT NONE * -* -- LAPACK computational routine (version 3.4.0) -- +* -- LAPACK computational routine (version 3.7.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * November 2016 @@ -181,9 +181,9 @@ * * Upper case -* +* IF( UPPER ) THEN -* +* IF( WANTZ ) THEN VPOS = MOD( SWEEP-1, 2 ) * N + ST TAUPOS = MOD( SWEEP-1, 2 ) * N + ST @@ -191,59 +191,67 @@ VPOS = MOD( SWEEP-1, 2 ) * N + ST TAUPOS = MOD( SWEEP-1, 2 ) * N + ST ENDIF - GO TO ( 101, 102, 103 ) TTYPE -* - 101 CONTINUE - LM = ED - ST + 1 -* - V( VPOS ) = ONE - DO 10 I = 1, LM-1 - V( VPOS+I ) = ( A( OFDPOS-I, ST+I ) ) - A( OFDPOS-I, ST+I ) = ZERO - 10 CONTINUE - CTMP = ( A( OFDPOS, ST ) ) - CALL SLARFG( LM, CTMP, V( VPOS+1 ), 1, - $ TAU( TAUPOS ) ) - A( OFDPOS, ST ) = CTMP -* - 103 CONTINUE - LM = ED - ST + 1 - CALL SLARFY( UPLO, LM, V( VPOS ), 1, ( TAU( TAUPOS ) ), - $ A( DPOS, ST ), LDA-1, WORK) - GOTO 300 -* - 102 CONTINUE - J1 = ED+1 - J2 = MIN( ED+NB, N ) - LN = ED-ST+1 - LM = J2-J1+1 - IF( LM.GT.0) THEN - CALL SLARFX( 'Left', LN, LM, V( VPOS ), - $ ( TAU( TAUPOS ) ), A( DPOS-NB, J1 ), - $ LDA-1, WORK) -* - IF( WANTZ ) THEN - VPOS = MOD( SWEEP-1, 2 ) * N + J1 - TAUPOS = MOD( SWEEP-1, 2 ) * N + J1 - ELSE - VPOS = MOD( SWEEP-1, 2 ) * N + J1 - TAUPOS = MOD( SWEEP-1, 2 ) * N + J1 - ENDIF +* + IF( TTYPE.EQ.1 ) THEN + LM = ED - ST + 1 * V( VPOS ) = ONE - DO 30 I = 1, LM-1 - V( VPOS+I ) = ( A( DPOS-NB-I, J1+I ) ) - A( DPOS-NB-I, J1+I ) = ZERO - 30 CONTINUE - CTMP = ( A( DPOS-NB, J1 ) ) - CALL SLARFG( LM, CTMP, V( VPOS+1 ), 1, TAU( TAUPOS ) ) - A( DPOS-NB, J1 ) = CTMP -* - CALL SLARFX( 'Right', LN-1, LM, V( VPOS ), - $ TAU( TAUPOS ), - $ A( DPOS-NB+1, J1 ), LDA-1, WORK) + DO 10 I = 1, LM-1 + V( VPOS+I ) = ( A( OFDPOS-I, ST+I ) ) + A( OFDPOS-I, ST+I ) = ZERO + 10 CONTINUE + CTMP = ( A( OFDPOS, ST ) ) + CALL SLARFG( LM, CTMP, V( VPOS+1 ), 1, + $ TAU( TAUPOS ) ) + A( OFDPOS, ST ) = CTMP +* + LM = ED - ST + 1 + CALL SLARFY( UPLO, LM, V( VPOS ), 1, + $ ( TAU( TAUPOS ) ), + $ A( DPOS, ST ), LDA-1, WORK) + ENDIF +* + IF( TTYPE.EQ.3 ) THEN +* + LM = ED - ST + 1 + CALL SLARFY( UPLO, LM, V( VPOS ), 1, + $ ( TAU( TAUPOS ) ), + $ A( DPOS, ST ), LDA-1, WORK) + ENDIF +* + IF( TTYPE.EQ.2 ) THEN + J1 = ED+1 + J2 = MIN( ED+NB, N ) + LN = ED-ST+1 + LM = J2-J1+1 + IF( LM.GT.0) THEN + CALL SLARFX( 'Left', LN, LM, V( VPOS ), + $ ( TAU( TAUPOS ) ), + $ A( DPOS-NB, J1 ), LDA-1, WORK) +* + IF( WANTZ ) THEN + VPOS = MOD( SWEEP-1, 2 ) * N + J1 + TAUPOS = MOD( SWEEP-1, 2 ) * N + J1 + ELSE + VPOS = MOD( SWEEP-1, 2 ) * N + J1 + TAUPOS = MOD( SWEEP-1, 2 ) * N + J1 + ENDIF +* + V( VPOS ) = ONE + DO 30 I = 1, LM-1 + V( VPOS+I ) = + $ ( A( DPOS-NB-I, J1+I ) ) + A( DPOS-NB-I, J1+I ) = ZERO + 30 CONTINUE + CTMP = ( A( DPOS-NB, J1 ) ) + CALL SLARFG( LM, CTMP, V( VPOS+1 ), 1, TAU( TAUPOS ) ) + A( DPOS-NB, J1 ) = CTMP +* + CALL SLARFX( 'Right', LN-1, LM, V( VPOS ), + $ TAU( TAUPOS ), + $ A( DPOS-NB+1, J1 ), LDA-1, WORK) + ENDIF ENDIF - GOTO 300 * * Lower case * @@ -256,63 +264,70 @@ VPOS = MOD( SWEEP-1, 2 ) * N + ST TAUPOS = MOD( SWEEP-1, 2 ) * N + ST ENDIF - GO TO ( 201, 202, 203 ) TTYPE -* - 201 CONTINUE - LM = ED - ST + 1 -* - V( VPOS ) = ONE - DO 20 I = 1, LM-1 - V( VPOS+I ) = A( OFDPOS+I, ST-1 ) - A( OFDPOS+I, ST-1 ) = ZERO - 20 CONTINUE - CALL SLARFG( LM, A( OFDPOS, ST-1 ), V( VPOS+1 ), 1, - $ TAU( TAUPOS ) ) -* - 203 CONTINUE - LM = ED - ST + 1 -* - CALL SLARFY( UPLO, LM, V( VPOS ), 1, ( TAU( TAUPOS ) ), - $ A( DPOS, ST ), LDA-1, WORK) - - GOTO 300 -* - 202 CONTINUE - J1 = ED+1 - J2 = MIN( ED+NB, N ) - LN = ED-ST+1 - LM = J2-J1+1 -* - IF( LM.GT.0) THEN - CALL SLARFX( 'Right', LM, LN, V( VPOS ), - $ TAU( TAUPOS ), A( DPOS+NB, ST ), - $ LDA-1, WORK) -* - IF( WANTZ ) THEN - VPOS = MOD( SWEEP-1, 2 ) * N + J1 - TAUPOS = MOD( SWEEP-1, 2 ) * N + J1 - ELSE - VPOS = MOD( SWEEP-1, 2 ) * N + J1 - TAUPOS = MOD( SWEEP-1, 2 ) * N + J1 - ENDIF -* +* + IF( TTYPE.EQ.1 ) THEN + LM = ED - ST + 1 +* V( VPOS ) = ONE - DO 40 I = 1, LM-1 - V( VPOS+I ) = A( DPOS+NB+I, ST ) - A( DPOS+NB+I, ST ) = ZERO - 40 CONTINUE - CALL SLARFG( LM, A( DPOS+NB, ST ), V( VPOS+1 ), 1, - $ TAU( TAUPOS ) ) -* - CALL SLARFX( 'Left', LM, LN-1, V( VPOS ), + DO 20 I = 1, LM-1 + V( VPOS+I ) = A( OFDPOS+I, ST-1 ) + A( OFDPOS+I, ST-1 ) = ZERO + 20 CONTINUE + CALL SLARFG( LM, A( OFDPOS, ST-1 ), V( VPOS+1 ), 1, + $ TAU( TAUPOS ) ) +* + LM = ED - ST + 1 +* + CALL SLARFY( UPLO, LM, V( VPOS ), 1, $ ( TAU( TAUPOS ) ), - $ A( DPOS+NB-1, ST+1 ), LDA-1, WORK) + $ A( DPOS, ST ), LDA-1, WORK) ENDIF - GOTO 300 - ENDIF +* + IF( TTYPE.EQ.3 ) THEN + LM = ED - ST + 1 +* + CALL SLARFY( UPLO, LM, V( VPOS ), 1, + $ ( TAU( TAUPOS ) ), + $ A( DPOS, ST ), LDA-1, WORK) - 300 CONTINUE + ENDIF +* + IF( TTYPE.EQ.2 ) THEN + J1 = ED+1 + J2 = MIN( ED+NB, N ) + LN = ED-ST+1 + LM = J2-J1+1 +* + IF( LM.GT.0) THEN + CALL SLARFX( 'Right', LM, LN, V( VPOS ), + $ TAU( TAUPOS ), A( DPOS+NB, ST ), + $ LDA-1, WORK) +* + IF( WANTZ ) THEN + VPOS = MOD( SWEEP-1, 2 ) * N + J1 + TAUPOS = MOD( SWEEP-1, 2 ) * N + J1 + ELSE + VPOS = MOD( SWEEP-1, 2 ) * N + J1 + TAUPOS = MOD( SWEEP-1, 2 ) * N + J1 + ENDIF +* + V( VPOS ) = ONE + DO 40 I = 1, LM-1 + V( VPOS+I ) = A( DPOS+NB+I, ST ) + A( DPOS+NB+I, ST ) = ZERO + 40 CONTINUE + CALL SLARFG( LM, A( DPOS+NB, ST ), V( VPOS+1 ), 1, + $ TAU( TAUPOS ) ) +* + CALL SLARFX( 'Left', LM, LN-1, V( VPOS ), + $ ( TAU( TAUPOS ) ), + $ A( DPOS+NB-1, ST+1 ), LDA-1, WORK) + + ENDIF + ENDIF + ENDIF +* RETURN * * END OF SSB2ST_KERNELS diff --git a/SRC/ssytrd_sb2st.F b/SRC/ssytrd_sb2st.F index b3e5d69c..17cab977 100644 --- a/SRC/ssytrd_sb2st.F +++ b/SRC/ssytrd_sb2st.F @@ -331,8 +331,9 @@ * Quick return if possible * IF( N.EQ.0 ) THEN - WORK( 1 ) = 1 - RETURN + HOUS( 1 ) = 1 + WORK( 1 ) = 1 + RETURN END IF * * Determine pointer position @@ -379,7 +380,10 @@ DO 40 I = 1, N-1 E( I ) = RZERO 40 CONTINUE - RETURN +* + HOUS( 1 ) = 1 + WORK( 1 ) = 1 + RETURN END IF * * Case KD=1: @@ -406,6 +410,9 @@ E( I ) = ( AB( ABOFDPOS, I ) ) 70 CONTINUE ENDIF +* + HOUS( 1 ) = 1 + WORK( 1 ) = 1 RETURN END IF * @@ -442,7 +449,7 @@ THED = MIN( (STT + THGRSIZ -1), (N-1)) DO 110 I = STT, N-1 ED = MIN( I, THED ) - IF( STT.GT.ED ) GOTO 100 + IF( STT.GT.ED ) EXIT DO 120 M = 1, STEPERCOL ST = STT DO 130 SWEEPID = ST, ED @@ -506,7 +513,7 @@ #endif IF ( BLKLASTIND.GE.(N-1) ) THEN STT = STT + 1 - GOTO 130 + EXIT ENDIF 140 CONTINUE 130 CONTINUE diff --git a/SRC/ssytrd_sy2sb.f b/SRC/ssytrd_sy2sb.f index 3dbbaf1f..039c3f07 100644 --- a/SRC/ssytrd_sy2sb.f +++ b/SRC/ssytrd_sy2sb.f @@ -1,6 +1,6 @@ *> \brief \b SSYTRD_SY2SB * -* @generated from zhetrd_he2hb.f, fortran z -> s, Sun Nov 6 19:34:06 2016 +* @generated from zhetrd_he2hb.f, fortran z -> s, Wed Dec 7 08:22:40 2016 * * =========== DOCUMENTATION =========== * @@ -245,7 +245,7 @@ * IMPLICIT NONE * -* -- LAPACK computational routine (version 3.4.0) -- +* -- LAPACK computational routine (version 3.7.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * November 2016 diff --git a/SRC/zhb2st_kernels.f b/SRC/zhb2st_kernels.f index ab03b303..065ba925 100644 --- a/SRC/zhb2st_kernels.f +++ b/SRC/zhb2st_kernels.f @@ -128,7 +128,7 @@ * IMPLICIT NONE * -* -- LAPACK computational routine (version 3.4.0) -- +* -- LAPACK computational routine (version 3.7.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * November 2016 @@ -181,9 +181,9 @@ * * Upper case -* +* IF( UPPER ) THEN -* +* IF( WANTZ ) THEN VPOS = MOD( SWEEP-1, 2 ) * N + ST TAUPOS = MOD( SWEEP-1, 2 ) * N + ST @@ -191,59 +191,67 @@ VPOS = MOD( SWEEP-1, 2 ) * N + ST TAUPOS = MOD( SWEEP-1, 2 ) * N + ST ENDIF - GO TO ( 101, 102, 103 ) TTYPE -* - 101 CONTINUE - LM = ED - ST + 1 -* - V( VPOS ) = ONE - DO 10 I = 1, LM-1 - V( VPOS+I ) = DCONJG( A( OFDPOS-I, ST+I ) ) - A( OFDPOS-I, ST+I ) = ZERO - 10 CONTINUE - CTMP = DCONJG( A( OFDPOS, ST ) ) - CALL ZLARFG( LM, CTMP, V( VPOS+1 ), 1, - $ TAU( TAUPOS ) ) - A( OFDPOS, ST ) = CTMP -* - 103 CONTINUE - LM = ED - ST + 1 - CALL ZLARFY( UPLO, LM, V( VPOS ), 1, DCONJG( TAU( TAUPOS ) ), - $ A( DPOS, ST ), LDA-1, WORK) - GOTO 300 -* - 102 CONTINUE - J1 = ED+1 - J2 = MIN( ED+NB, N ) - LN = ED-ST+1 - LM = J2-J1+1 - IF( LM.GT.0) THEN - CALL ZLARFX( 'Left', LN, LM, V( VPOS ), - $ DCONJG( TAU( TAUPOS ) ), A( DPOS-NB, J1 ), - $ LDA-1, WORK) -* - IF( WANTZ ) THEN - VPOS = MOD( SWEEP-1, 2 ) * N + J1 - TAUPOS = MOD( SWEEP-1, 2 ) * N + J1 - ELSE - VPOS = MOD( SWEEP-1, 2 ) * N + J1 - TAUPOS = MOD( SWEEP-1, 2 ) * N + J1 - ENDIF +* + IF( TTYPE.EQ.1 ) THEN + LM = ED - ST + 1 * V( VPOS ) = ONE - DO 30 I = 1, LM-1 - V( VPOS+I ) = DCONJG( A( DPOS-NB-I, J1+I ) ) - A( DPOS-NB-I, J1+I ) = ZERO - 30 CONTINUE - CTMP = DCONJG( A( DPOS-NB, J1 ) ) - CALL ZLARFG( LM, CTMP, V( VPOS+1 ), 1, TAU( TAUPOS ) ) - A( DPOS-NB, J1 ) = CTMP -* - CALL ZLARFX( 'Right', LN-1, LM, V( VPOS ), - $ TAU( TAUPOS ), - $ A( DPOS-NB+1, J1 ), LDA-1, WORK) + DO 10 I = 1, LM-1 + V( VPOS+I ) = DCONJG( A( OFDPOS-I, ST+I ) ) + A( OFDPOS-I, ST+I ) = ZERO + 10 CONTINUE + CTMP = DCONJG( A( OFDPOS, ST ) ) + CALL ZLARFG( LM, CTMP, V( VPOS+1 ), 1, + $ TAU( TAUPOS ) ) + A( OFDPOS, ST ) = CTMP +* + LM = ED - ST + 1 + CALL ZLARFY( UPLO, LM, V( VPOS ), 1, + $ DCONJG( TAU( TAUPOS ) ), + $ A( DPOS, ST ), LDA-1, WORK) + ENDIF +* + IF( TTYPE.EQ.3 ) THEN +* + LM = ED - ST + 1 + CALL ZLARFY( UPLO, LM, V( VPOS ), 1, + $ DCONJG( TAU( TAUPOS ) ), + $ A( DPOS, ST ), LDA-1, WORK) + ENDIF +* + IF( TTYPE.EQ.2 ) THEN + J1 = ED+1 + J2 = MIN( ED+NB, N ) + LN = ED-ST+1 + LM = J2-J1+1 + IF( LM.GT.0) THEN + CALL ZLARFX( 'Left', LN, LM, V( VPOS ), + $ DCONJG( TAU( TAUPOS ) ), + $ A( DPOS-NB, J1 ), LDA-1, WORK) +* + IF( WANTZ ) THEN + VPOS = MOD( SWEEP-1, 2 ) * N + J1 + TAUPOS = MOD( SWEEP-1, 2 ) * N + J1 + ELSE + VPOS = MOD( SWEEP-1, 2 ) * N + J1 + TAUPOS = MOD( SWEEP-1, 2 ) * N + J1 + ENDIF +* + V( VPOS ) = ONE + DO 30 I = 1, LM-1 + V( VPOS+I ) = + $ DCONJG( A( DPOS-NB-I, J1+I ) ) + A( DPOS-NB-I, J1+I ) = ZERO + 30 CONTINUE + CTMP = DCONJG( A( DPOS-NB, J1 ) ) + CALL ZLARFG( LM, CTMP, V( VPOS+1 ), 1, TAU( TAUPOS ) ) + A( DPOS-NB, J1 ) = CTMP +* + CALL ZLARFX( 'Right', LN-1, LM, V( VPOS ), + $ TAU( TAUPOS ), + $ A( DPOS-NB+1, J1 ), LDA-1, WORK) + ENDIF ENDIF - GOTO 300 * * Lower case * @@ -256,63 +264,70 @@ VPOS = MOD( SWEEP-1, 2 ) * N + ST TAUPOS = MOD( SWEEP-1, 2 ) * N + ST ENDIF - GO TO ( 201, 202, 203 ) TTYPE -* - 201 CONTINUE - LM = ED - ST + 1 -* - V( VPOS ) = ONE - DO 20 I = 1, LM-1 - V( VPOS+I ) = A( OFDPOS+I, ST-1 ) - A( OFDPOS+I, ST-1 ) = ZERO - 20 CONTINUE - CALL ZLARFG( LM, A( OFDPOS, ST-1 ), V( VPOS+1 ), 1, - $ TAU( TAUPOS ) ) -* - 203 CONTINUE - LM = ED - ST + 1 -* - CALL ZLARFY( UPLO, LM, V( VPOS ), 1, DCONJG( TAU( TAUPOS ) ), - $ A( DPOS, ST ), LDA-1, WORK) - - GOTO 300 -* - 202 CONTINUE - J1 = ED+1 - J2 = MIN( ED+NB, N ) - LN = ED-ST+1 - LM = J2-J1+1 -* - IF( LM.GT.0) THEN - CALL ZLARFX( 'Right', LM, LN, V( VPOS ), - $ TAU( TAUPOS ), A( DPOS+NB, ST ), - $ LDA-1, WORK) -* - IF( WANTZ ) THEN - VPOS = MOD( SWEEP-1, 2 ) * N + J1 - TAUPOS = MOD( SWEEP-1, 2 ) * N + J1 - ELSE - VPOS = MOD( SWEEP-1, 2 ) * N + J1 - TAUPOS = MOD( SWEEP-1, 2 ) * N + J1 - ENDIF -* +* + IF( TTYPE.EQ.1 ) THEN + LM = ED - ST + 1 +* V( VPOS ) = ONE - DO 40 I = 1, LM-1 - V( VPOS+I ) = A( DPOS+NB+I, ST ) - A( DPOS+NB+I, ST ) = ZERO - 40 CONTINUE - CALL ZLARFG( LM, A( DPOS+NB, ST ), V( VPOS+1 ), 1, - $ TAU( TAUPOS ) ) -* - CALL ZLARFX( 'Left', LM, LN-1, V( VPOS ), + DO 20 I = 1, LM-1 + V( VPOS+I ) = A( OFDPOS+I, ST-1 ) + A( OFDPOS+I, ST-1 ) = ZERO + 20 CONTINUE + CALL ZLARFG( LM, A( OFDPOS, ST-1 ), V( VPOS+1 ), 1, + $ TAU( TAUPOS ) ) +* + LM = ED - ST + 1 +* + CALL ZLARFY( UPLO, LM, V( VPOS ), 1, $ DCONJG( TAU( TAUPOS ) ), - $ A( DPOS+NB-1, ST+1 ), LDA-1, WORK) + $ A( DPOS, ST ), LDA-1, WORK) ENDIF - GOTO 300 - ENDIF +* + IF( TTYPE.EQ.3 ) THEN + LM = ED - ST + 1 +* + CALL ZLARFY( UPLO, LM, V( VPOS ), 1, + $ DCONJG( TAU( TAUPOS ) ), + $ A( DPOS, ST ), LDA-1, WORK) - 300 CONTINUE + ENDIF +* + IF( TTYPE.EQ.2 ) THEN + J1 = ED+1 + J2 = MIN( ED+NB, N ) + LN = ED-ST+1 + LM = J2-J1+1 +* + IF( LM.GT.0) THEN + CALL ZLARFX( 'Right', LM, LN, V( VPOS ), + $ TAU( TAUPOS ), A( DPOS+NB, ST ), + $ LDA-1, WORK) +* + IF( WANTZ ) THEN + VPOS = MOD( SWEEP-1, 2 ) * N + J1 + TAUPOS = MOD( SWEEP-1, 2 ) * N + J1 + ELSE + VPOS = MOD( SWEEP-1, 2 ) * N + J1 + TAUPOS = MOD( SWEEP-1, 2 ) * N + J1 + ENDIF +* + V( VPOS ) = ONE + DO 40 I = 1, LM-1 + V( VPOS+I ) = A( DPOS+NB+I, ST ) + A( DPOS+NB+I, ST ) = ZERO + 40 CONTINUE + CALL ZLARFG( LM, A( DPOS+NB, ST ), V( VPOS+1 ), 1, + $ TAU( TAUPOS ) ) +* + CALL ZLARFX( 'Left', LM, LN-1, V( VPOS ), + $ DCONJG( TAU( TAUPOS ) ), + $ A( DPOS+NB-1, ST+1 ), LDA-1, WORK) + + ENDIF + ENDIF + ENDIF +* RETURN * * END OF ZHB2ST_KERNELS diff --git a/SRC/zhetrd_hb2st.F b/SRC/zhetrd_hb2st.F index 71419481..9671e49c 100644 --- a/SRC/zhetrd_hb2st.F +++ b/SRC/zhetrd_hb2st.F @@ -334,8 +334,9 @@ * Quick return if possible * IF( N.EQ.0 ) THEN - WORK( 1 ) = 1 - RETURN + HOUS( 1 ) = 1 + WORK( 1 ) = 1 + RETURN END IF * * Determine pointer position @@ -382,7 +383,10 @@ DO 40 I = 1, N-1 E( I ) = RZERO 40 CONTINUE - RETURN +* + HOUS( 1 ) = 1 + WORK( 1 ) = 1 + RETURN END IF * * Case KD=1: @@ -437,6 +441,9 @@ C CALL ZSCAL( N, TMP, Q( 1, I+1 ), 1 ) C END IF 70 CONTINUE ENDIF +* + HOUS( 1 ) = 1 + WORK( 1 ) = 1 RETURN END IF * @@ -473,7 +480,7 @@ C END IF THED = MIN( (STT + THGRSIZ -1), (N-1)) DO 110 I = STT, N-1 ED = MIN( I, THED ) - IF( STT.GT.ED ) GOTO 100 + IF( STT.GT.ED ) EXIT DO 120 M = 1, STEPERCOL ST = STT DO 130 SWEEPID = ST, ED @@ -537,7 +544,7 @@ C END IF #endif IF ( BLKLASTIND.GE.(N-1) ) THEN STT = STT + 1 - GOTO 130 + EXIT ENDIF 140 CONTINUE 130 CONTINUE diff --git a/SRC/zhetrd_he2hb.f b/SRC/zhetrd_he2hb.f index 9403b73e..7a283c7b 100644 --- a/SRC/zhetrd_he2hb.f +++ b/SRC/zhetrd_he2hb.f @@ -245,7 +245,7 @@ * IMPLICIT NONE * -* -- LAPACK computational routine (version 3.4.0) -- +* -- LAPACK computational routine (version 3.7.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * November 2016 diff --git a/TESTING/LIN/cchkaa.f b/TESTING/LIN/cchkaa.f index f2ef59f1..5881043f 100644 --- a/TESTING/LIN/cchkaa.f +++ b/TESTING/LIN/cchkaa.f @@ -1047,8 +1047,7 @@ CALL CDRVLS( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, NNB, $ NBVAL, NXVAL, THRESH, TSTERR, A( 1, 1 ), $ A( 1, 2 ), A( 1, 3 ), A( 1, 4 ), A( 1, 5 ), - $ S( 1 ), S( NMAX+1 ), WORK, RWORK, IWORK, - $ NOUT ) + $ S( 1 ), S( NMAX+1 ), NOUT ) ELSE WRITE( NOUT, FMT = 9989 )PATH END IF diff --git a/TESTING/LIN/cdrvls.f b/TESTING/LIN/cdrvls.f index ededde5a..49c99354 100644 --- a/TESTING/LIN/cdrvls.f +++ b/TESTING/LIN/cdrvls.f @@ -10,8 +10,7 @@ * * SUBROUTINE CDRVLS( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, NNB, * NBVAL, NXVAL, THRESH, TSTERR, A, COPYA, B, -* COPYB, C, S, COPYS, WORK, RWORK, IWORK, -* NOUT ) +* COPYB, C, S, COPYS, NOUT ) * * .. Scalar Arguments .. * LOGICAL TSTERR @@ -20,11 +19,10 @@ * .. * .. Array Arguments .. * LOGICAL DOTYPE( * ) -* INTEGER IWORK( * ), MVAL( * ), NBVAL( * ), NSVAL( * ), +* INTEGER MVAL( * ), NBVAL( * ), NSVAL( * ), * $ NVAL( * ), NXVAL( * ) -* REAL COPYS( * ), RWORK( * ), S( * ) -* COMPLEX A( * ), B( * ), C( * ), COPYA( * ), COPYB( * ), -* $ WORK( * ) +* REAL COPYS( * ), S( * ) +* COMPLEX A( * ), B( * ), C( * ), COPYA( * ), COPYB( * ) * .. * * @@ -33,7 +31,7 @@ *> *> \verbatim *> -*> CDRVLS tests the least squares driver routines CGELS, CGELSS, CGELSY +*> CDRVLS tests the least squares driver routines CGELS, CGETSLS, CGELSS, CGELSY *> and CGELSD. *> \endverbatim * @@ -171,22 +169,6 @@ *> (min(MMAX,NMAX)) *> \endverbatim *> -*> \param[out] WORK -*> \verbatim -*> WORK is COMPLEX array, dimension -*> (MMAX*NMAX + 4*NMAX + MMAX). -*> \endverbatim -*> -*> \param[out] RWORK -*> \verbatim -*> RWORK is REAL array, dimension (5*NMAX-1) -*> \endverbatim -*> -*> \param[out] IWORK -*> \verbatim -*> IWORK is INTEGER array, dimension (15*NMAX) -*> \endverbatim -*> *> \param[in] NOUT *> \verbatim *> NOUT is INTEGER @@ -208,8 +190,7 @@ * ===================================================================== SUBROUTINE CDRVLS( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, NNB, $ NBVAL, NXVAL, THRESH, TSTERR, A, COPYA, B, - $ COPYB, C, S, COPYS, WORK, RWORK, IWORK, - $ NOUT ) + $ COPYB, C, S, COPYS, NOUT ) * * -- LAPACK test routine (version 3.6.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -223,11 +204,10 @@ * .. * .. Array Arguments .. LOGICAL DOTYPE( * ) - INTEGER IWORK( * ), MVAL( * ), NBVAL( * ), NSVAL( * ), + INTEGER MVAL( * ), NBVAL( * ), NSVAL( * ), $ NVAL( * ), NXVAL( * ) - REAL COPYS( * ), RWORK( * ), S( * ) - COMPLEX A( * ), B( * ), C( * ), COPYA( * ), COPYB( * ), - $ WORK( * ) + REAL COPYS( * ), S( * ) + COMPLEX A( * ), B( * ), C( * ), COPYA( * ), COPYB( * ) * .. * * ===================================================================== @@ -249,12 +229,22 @@ INTEGER CRANK, I, IM, IMB, IN, INB, INFO, INS, IRANK, $ ISCALE, ITRAN, ITYPE, J, K, LDA, LDB, LDWORK, $ LWLSY, LWORK, M, MNMIN, N, NB, NCOLS, NERRS, - $ NFAIL, NRHS, NROWS, NRUN, RANK, MB, LWTS + $ NFAIL, NRHS, NROWS, NRUN, RANK, MB, + $ MMAX, NMAX, NSMAX, LIWORK, LRWORK, + $ LWORK_CGELS, LWORK_CGETSLS, LWORK_CGELSS, + $ LWORK_CGELSY, LWORK_CGELSD, + $ LRWORK_CGELSY, LRWORK_CGELSS, LRWORK_CGELSD REAL EPS, NORMA, NORMB, RCOND * .. * .. Local Arrays .. - INTEGER ISEED( 4 ), ISEEDY( 4 ) - REAL RESULT( NTESTS ) + INTEGER ISEED( 4 ), ISEEDY( 4 ), IWORKQUERY + REAL RESULT( NTESTS ), RWORKQUERY + COMPLEX WORKQUERY +* .. +* .. Allocatable Arrays .. + COMPLEX, ALLOCATABLE :: WORK (:) + REAL, ALLOCATABLE :: RWORK (:) + INTEGER, ALLOCATABLE :: IWORK (:) * .. * .. External Functions .. REAL CQRT12, CQRT14, CQRT17, SASUM, SLAMCH @@ -267,7 +257,7 @@ $ SAXPY, XLAENV * .. * .. Intrinsic Functions .. - INTRINSIC MAX, MIN, REAL, SQRT + INTRINSIC MAX, MIN, INT, REAL, SQRT * .. * .. Scalars in Common .. LOGICAL LERR, OK @@ -311,6 +301,77 @@ $ CALL ALAHD( NOUT, PATH ) INFOT = 0 * +* Compute maximal workspace needed for all routines +* + NMAX = 0 + MMAX = 0 + NSMAX = 0 + DO I = 1, NM + IF ( MVAL( I ).GT.MMAX ) THEN + MMAX = MVAL( I ) + END IF + ENDDO + DO I = 1, NN + IF ( NVAL( I ).GT.NMAX ) THEN + NMAX = NVAL( I ) + END IF + ENDDO + DO I = 1, NNS + IF ( NSVAL( I ).GT.NSMAX ) THEN + NSMAX = NSVAL( I ) + END IF + ENDDO + M = MMAX + N = NMAX + NRHS = NSMAX + LDA = MAX( 1, M ) + LDB = MAX( 1, M, N ) + MNMIN = MAX( MIN( M, N ), 1 ) +* +* Compute workspace needed for routines +* CQRT14, CQRT17 (two side cases), CQRT15 and CQRT12 +* + LWORK = MAX( ( M+N )*NRHS, + $ ( N+NRHS )*( M+2 ), ( M+NRHS )*( N+2 ), + $ MAX( M+MNMIN, NRHS*MNMIN,2*N+M ), + $ MAX( M*N+4*MNMIN+MAX(M,N), M*N+2*MNMIN+4*N ) ) +* +* Compute workspace needed for CGELS + CALL CGELS( 'N', M, N, NRHS, A, LDA, B, LDB, + $ WORKQUERY, -1, INFO ) + LWORK_CGELS = INT( WORKQUERY ) +* Compute workspace needed for CGETSLS + CALL CGETSLS( 'N', M, N, NRHS, A, LDA, B, LDB, + $ WORKQUERY, -1, INFO ) + LWORK_CGETSLS = INT( WORKQUERY ) +* Compute workspace needed for CGELSY + CALL CGELSY( M, N, NRHS, A, LDA, B, LDB, IWORKQUERY, + $ RCOND, CRANK, WORKQUERY, -1, RWORK, INFO ) + LWORK_CGELSY = INT( WORKQUERY ) + LRWORK_CGELSY = 2*N +* Compute workspace needed for CGELSS + CALL CGELSS( M, N, NRHS, A, LDA, B, LDB, S, + $ RCOND, CRANK, WORKQUERY, -1, RWORK, INFO ) + LWORK_CGELSS = INT( WORKQUERY ) + LRWORK_CGELSS = 5*MNMIN +* Compute workspace needed for CGELSD + CALL CGELSD( M, N, NRHS, A, LDA, B, LDB, S, RCOND, CRANK, + $ WORKQUERY, -1, RWORKQUERY, IWORKQUERY, INFO ) + LWORK_CGELSD = INT( WORKQUERY ) + LRWORK_CGELSD = INT( RWORKQUERY ) +* Compute LIWORK workspace needed for CGELSY and CGELSD + LIWORK = MAX( 1, N, IWORKQUERY ) +* Compute LRWORK workspace needed for CGELSY, CGELSS and CGELSD + LRWORK = MAX( 1, LRWORK_CGELSY, LRWORK_CGELSS, LRWORK_CGELSD ) +* Compute LWORK workspace needed for all functions + LWORK = MAX( 1, LWORK, LWORK_CGELS, LWORK_CGETSLS, LWORK_CGELSY, + $ LWORK_CGELSS, LWORK_CGELSD ) + LWLSY = LWORK +* + ALLOCATE( WORK( LWORK ) ) + ALLOCATE( IWORK( LIWORK ) ) + ALLOCATE( RWORK( LRWORK ) ) +* DO 140 IM = 1, NM M = MVAL( IM ) LDA = MAX( 1, M ) @@ -320,16 +381,9 @@ MNMIN = MAX(MIN( M, N ),1) LDB = MAX( 1, M, N ) MB = (MNMIN+1) - IF(MNMIN.NE.MB) THEN - LWTS = (((LDB-MB)/(MB-MNMIN))*MNMIN+MNMIN*2)*MB+5 - ELSE - LWTS = 2*MNMIN+5 - END IF * DO 120 INS = 1, NNS NRHS = NSVAL( INS ) - LWORK = MAX( 1, ( M+NRHS )*( N+2 ), ( N+NRHS )*( M+2 ), - $ M*N+4*MNMIN+MAX( M, N ), 2*N+M, LWTS ) * DO 110 IRANK = 1, 2 DO 100 ISCALE = 1, 3 @@ -580,12 +634,6 @@ IWORK( J ) = 0 70 CONTINUE * -* Set LWLSY to the adequate value. -* - LWLSY = MNMIN + MAX( 2*MNMIN, NB*( N+1 ), - $ MNMIN+NB*NRHS ) - LWLSY = MAX( 1, LWLSY ) -* SRNAMT = 'CGELSY' CALL CGELSY( M, N, NRHS, A, LDA, B, LDB, IWORK, $ RCOND, CRANK, WORK, LWLSY, RWORK, @@ -776,6 +824,10 @@ 9997 FORMAT( ' TRANS=''', A1,' M=', I5, ', N=', I5, ', NRHS=', I4, $ ', MB=', I4,', NB=', I4,', type', I2, $ ', test(', I2, ')=', G12.5 ) +* + DEALLOCATE( WORK ) + DEALLOCATE( RWORK ) + DEALLOCATE( IWORK ) RETURN * * End of CDRVLS diff --git a/TESTING/LIN/ctsqr01.f b/TESTING/LIN/ctsqr01.f index a437386b..23046cd7 100644 --- a/TESTING/LIN/ctsqr01.f +++ b/TESTING/LIN/ctsqr01.f @@ -109,11 +109,12 @@ * .. * .. Local Scalars .. LOGICAL TESTZEROS, TS - INTEGER INFO, J, K, L, LWORK, LT ,MNB + INTEGER INFO, J, K, L, LWORK, TSIZE, MNB REAL ANORM, EPS, RESID, CNORM, DNORM * .. * .. Local Arrays .. INTEGER ISEED( 4 ) + COMPLEX TQUERY( 5 ), WORKQUERY * .. * .. External Functions .. REAL SLAMCH, CLANGE, CLANSY @@ -145,17 +146,11 @@ L = MAX(M,N,1) MNB = MAX ( MB, NB) LWORK = MAX(3,L)*MNB - IF((K.GE.MNB).OR.(MNB.GE.L))THEN - LT=MAX(1,L)*MNB+5 - ELSE - LT=MAX(1,(L-K)/(MNB-K)+1)*L*MNB+5 - END IF - * * Dynamically allocate local arrays * ALLOCATE ( A(M,N), AF(M,N), Q(L,L), R(M,L), RWORK(L), - $ WORK(LWORK), T(LT), C(M,N), CF(M,N), + $ C(M,N), CF(M,N), $ D(N,M), DF(N,M), LQ(L,N) ) * * Put random numbers into A and copy to AF @@ -176,14 +171,34 @@ * * Factor the matrix A in the array AF. * + CALL CGEQR( M, N, AF, M, TQUERY, -1, WORKQUERY, -1, INFO ) + TSIZE = INT( TQUERY( 1 ) ) + LWORK = INT( WORKQUERY ) + CALL CGEMQR( 'L', 'N', M, M, K, AF, M, TQUERY, TSIZE, CF, M, + $ WORKQUERY, -1, INFO) + LWORK = MAX( LWORK, INT( WORKQUERY ) ) + CALL CGEMQR( 'L', 'N', M, N, K, AF, M, TQUERY, TSIZE, CF, M, + $ WORKQUERY, -1, INFO) + LWORK = MAX( LWORK, INT( WORKQUERY ) + CALL CGEMQR( 'L', 'C', M, N, K, AF, M, TQUERY, TSIZE, CF, M, + $ WORKQUERY, -1, INFO) + LWORK = MAX( LWORK, INT( WORKQUERY ) ) + CALL CGEMQR( 'R', 'N', N, M, K, AF, M, TQUERY, TSIZE, DF, N, + $ WORKQUERY, -1, INFO) + LWORK = MAX( LWORK, INT( WORKQUERY ) ) + CALL CGEMQR( 'R', 'C', N, M, K, AF, M, TQUERY, TSIZE, DF, N, + $ WORKQUERY, -1, INFO) + LWORK = MAX( LWORK, INT( WORKQUERY ) ) + ALLOCATE ( T( TSIZE ) ) + ALLOCATE ( WORK( LWORK ) ) srnamt = 'CGEQR' - CALL CGEQR( M, N, AF, M, T, LT, WORK, LWORK, INFO ) + CALL CGEQR( M, N, AF, M, T, TSIZE, WORK, LWORK, INFO ) * * Generate the m-by-m matrix Q * CALL CLASET( 'Full', M, M, CZERO, ONE, Q, M ) srnamt = 'CGEMQR' - CALL CGEMQR( 'L', 'N', M, M, K, AF, M, T, LT, Q, M, + CALL CGEMQR( 'L', 'N', M, M, K, AF, M, T, TSIZE, Q, M, $ WORK, LWORK, INFO ) * * Copy R @@ -220,7 +235,7 @@ * Apply Q to C as Q*C * srnamt = 'CGEMQR' - CALL CGEMQR( 'L', 'N', M, N, K, AF, M, T, LT, CF, M, + CALL CGEMQR( 'L', 'N', M, N, K, AF, M, T, TSIZE, CF, M, $ WORK, LWORK, INFO) * * Compute |Q*C - Q*C| / |C| @@ -240,7 +255,7 @@ * Apply Q to C as QT*C * srnamt = 'CGEMQR' - CALL CGEMQR( 'L', 'C', M, N, K, AF, M, T, LT, CF, M, + CALL CGEMQR( 'L', 'C', M, N, K, AF, M, T, TSIZE, CF, M, $ WORK, LWORK, INFO) * * Compute |QT*C - QT*C| / |C| @@ -264,7 +279,7 @@ * Apply Q to D as D*Q * srnamt = 'CGEMQR' - CALL CGEMQR( 'R', 'N', N, M, K, AF, M, T, LT, DF, N, + CALL CGEMQR( 'R', 'N', N, M, K, AF, M, T, TSIZE, DF, N, $ WORK, LWORK, INFO) * * Compute |D*Q - D*Q| / |D| @@ -283,7 +298,7 @@ * * Apply Q to D as D*QT * - CALL CGEMQR( 'R', 'C', N, M, K, AF, M, T, LT, DF, N, + CALL CGEMQR( 'R', 'C', N, M, K, AF, M, T, TSIZE, DF, N, $ WORK, LWORK, INFO) * * Compute |D*QT - D*QT| / |D| @@ -299,15 +314,35 @@ * Short and wide * ELSE + CALL CGELQ( M, N, AF, M, TQUERY, -1, WORKQUERY, -1, INFO ) + TSIZE = INT( TQUERY( 1 ) ) + LWORK = INT( WORKQUERY ) + CALL CGEMLQ( 'R', 'N', N, N, K, AF, M, TQUERY, TSIZE, Q, N, + $ WORKQUERY, -1, INFO ) + LWORK = MAX( LWORK, INT( WORKQUERY ) ) + CALL CGEMLQ( 'L', 'N', N, M, K, AF, M, TQUERY, TSIZE, DF, N, + $ WORKQUERY, -1, INFO) + LWORK = MAX( LWORK, INT( WORKQUERY ) ) + CALL CGEMLQ( 'L', 'C', N, M, K, AF, M, TQUERY, TSIZE, DF, N, + $ WORKQUERY, -1, INFO) + LWORK = MAX( LWORK, INT( WORKQUERY ) ) + CALL CGEMLQ( 'R', 'N', M, N, K, AF, M, TQUERY, TSIZE, CF, M, + $ WORKQUERY, -1, INFO) + LWORK = MAX( LWORK, INT( WORKQUERY ) ) + CALL CGEMLQ( 'R', 'C', M, N, K, AF, M, TQUERY, TSIZE, CF, M, + $ WORKQUERY, -1, INFO) + LWORK = MAX( LWORK, INT( WORKQUERY ) ) + ALLOCATE ( T( TSIZE ) ) + ALLOCATE ( WORK( LWORK ) ) srnamt = 'CGELQ' - CALL CGELQ( M, N, AF, M, T, LT, WORK, LWORK, INFO ) + CALL CGELQ( M, N, AF, M, T, TSIZE, WORK, LWORK, INFO ) * * * Generate the n-by-n matrix Q * CALL CLASET( 'Full', N, N, CZERO, ONE, Q, N ) srnamt = 'CGEMLQ' - CALL CGEMLQ( 'R', 'N', N, N, K, AF, M, T, LT, Q, N, + CALL CGEMLQ( 'R', 'N', N, N, K, AF, M, T, TSIZE, Q, N, $ WORK, LWORK, INFO ) * * Copy R @@ -343,7 +378,7 @@ * * Apply Q to C as Q*C * - CALL CGEMLQ( 'L', 'N', N, M, K, AF, M, T, LT, DF, N, + CALL CGEMLQ( 'L', 'N', N, M, K, AF, M, T, TSIZE, DF, N, $ WORK, LWORK, INFO) * * Compute |Q*D - Q*D| / |D| @@ -362,7 +397,7 @@ * * Apply Q to D as QT*D * - CALL CGEMLQ( 'L', 'C', N, M, K, AF, M, T, LT, DF, N, + CALL CGEMLQ( 'L', 'C', N, M, K, AF, M, T, TSIZE, DF, N, $ WORK, LWORK, INFO) * * Compute |QT*D - QT*D| / |D| @@ -385,7 +420,7 @@ * * Apply Q to C as C*Q * - CALL CGEMLQ( 'R', 'N', M, N, K, AF, M, T, LT, CF, M, + CALL CGEMLQ( 'R', 'N', M, N, K, AF, M, T, TSIZE, CF, M, $ WORK, LWORK, INFO) * * Compute |C*Q - C*Q| / |C| @@ -404,7 +439,7 @@ * * Apply Q to D as D*QT * - CALL CGEMLQ( 'R', 'C', M, N, K, AF, M, T, LT, CF, M, + CALL CGEMLQ( 'R', 'C', M, N, K, AF, M, T, TSIZE, CF, M, $ WORK, LWORK, INFO) * * Compute |C*QT - C*QT| / |C| diff --git a/TESTING/LIN/dchkaa.f b/TESTING/LIN/dchkaa.f index 5d122d38..707517d2 100644 --- a/TESTING/LIN/dchkaa.f +++ b/TESTING/LIN/dchkaa.f @@ -907,7 +907,7 @@ CALL DDRVLS( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, NNB, $ NBVAL, NXVAL, THRESH, TSTERR, A( 1, 1 ), $ A( 1, 2 ), B( 1, 1 ), B( 1, 2 ), B( 1, 3 ), - $ RWORK, RWORK( NMAX+1 ), WORK, IWORK, NOUT ) + $ RWORK, RWORK( NMAX+1 ), NOUT ) ELSE WRITE( NOUT, FMT = 9988 )PATH END IF diff --git a/TESTING/LIN/ddrvls.f b/TESTING/LIN/ddrvls.f index d11f910e..74b0c336 100644 --- a/TESTING/LIN/ddrvls.f +++ b/TESTING/LIN/ddrvls.f @@ -10,7 +10,7 @@ * * SUBROUTINE DDRVLS( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, NNB, * NBVAL, NXVAL, THRESH, TSTERR, A, COPYA, B, -* COPYB, C, S, COPYS, WORK, IWORK, NOUT ) +* COPYB, C, S, COPYS, NOUT ) * * .. Scalar Arguments .. * LOGICAL TSTERR @@ -19,10 +19,10 @@ * .. * .. Array Arguments .. * LOGICAL DOTYPE( * ) -* INTEGER IWORK( * ), MVAL( * ), NBVAL( * ), NSVAL( * ), +* INTEGER MVAL( * ), NBVAL( * ), NSVAL( * ), * $ NVAL( * ), NXVAL( * ) * DOUBLE PRECISION A( * ), B( * ), C( * ), COPYA( * ), COPYB( * ), -* $ COPYS( * ), S( * ), WORK( * ) +* $ COPYS( * ), S( * ) * .. * * @@ -169,17 +169,6 @@ *> (min(MMAX,NMAX)) *> \endverbatim *> -*> \param[out] WORK -*> \verbatim -*> WORK is DOUBLE PRECISION array, -*> dimension (MMAX*NMAX + 4*NMAX + MMAX). -*> \endverbatim -*> -*> \param[out] IWORK -*> \verbatim -*> IWORK is INTEGER array, dimension (15*NMAX) -*> \endverbatim -*> *> \param[in] NOUT *> \verbatim *> NOUT is INTEGER @@ -201,7 +190,7 @@ * ===================================================================== SUBROUTINE DDRVLS( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, NNB, $ NBVAL, NXVAL, THRESH, TSTERR, A, COPYA, B, - $ COPYB, C, S, COPYS, WORK, IWORK, NOUT ) + $ COPYB, C, S, COPYS, NOUT ) * * -- LAPACK test routine (version 3.6.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -215,10 +204,10 @@ * .. * .. Array Arguments .. LOGICAL DOTYPE( * ) - INTEGER IWORK( * ), MVAL( * ), NBVAL( * ), NSVAL( * ), + INTEGER MVAL( * ), NBVAL( * ), NSVAL( * ), $ NVAL( * ), NXVAL( * ) DOUBLE PRECISION A( * ), B( * ), C( * ), COPYA( * ), COPYB( * ), - $ COPYS( * ), S( * ), WORK( * ) + $ COPYS( * ), S( * ) * .. * * ===================================================================== @@ -237,12 +226,19 @@ INTEGER CRANK, I, IM, IMB, IN, INB, INFO, INS, IRANK, $ ISCALE, ITRAN, ITYPE, J, K, LDA, LDB, LDWORK, $ LWLSY, LWORK, M, MNMIN, N, NB, NCOLS, NERRS, - $ NFAIL, NLVL, NRHS, NROWS, NRUN, RANK, MB, LWTS + $ NFAIL, NRHS, NROWS, NRUN, RANK, MB, + $ MMAX, NMAX, NSMAX, LIWORK, + $ LWORK_DGELS, LWORK_DGETSLS, LWORK_DGELSS, + $ LWORK_DGELSY, LWORK_DGELSD DOUBLE PRECISION EPS, NORMA, NORMB, RCOND * .. * .. Local Arrays .. - INTEGER ISEED( 4 ), ISEEDY( 4 ) - DOUBLE PRECISION RESULT( NTESTS ) + INTEGER ISEED( 4 ), ISEEDY( 4 ), IWORKQUERY + DOUBLE PRECISION RESULT( NTESTS ), WORKQUERY +* .. +* .. Allocatable Arrays .. + DOUBLE PRECISION, ALLOCATABLE :: WORK (:) + INTEGER, ALLOCATABLE :: IWORK (:) * .. * .. External Functions .. DOUBLE PRECISION DASUM, DLAMCH, DQRT12, DQRT14, DQRT17 @@ -302,6 +298,71 @@ CALL XLAENV( 2, 2 ) CALL XLAENV( 9, SMLSIZ ) * +* Compute maximal workspace needed for all routines +* + NMAX = 0 + MMAX = 0 + NSMAX = 0 + DO I = 1, NM + IF ( MVAL( I ).GT.MMAX ) THEN + MMAX = MVAL( I ) + END IF + ENDDO + DO I = 1, NN + IF ( NVAL( I ).GT.NMAX ) THEN + NMAX = NVAL( I ) + END IF + ENDDO + DO I = 1, NNS + IF ( NSVAL( I ).GT.NSMAX ) THEN + NSMAX = NSVAL( I ) + END IF + ENDDO + M = MMAX + N = NMAX + NRHS = NSMAX + LDA = MAX( 1, M ) + LDB = MAX( 1, M, N ) + MNMIN = MAX( MIN( M, N ), 1 ) +* +* Compute workspace needed for routines +* DQRT14, DQRT17 (two side cases), DQRT15 and DQRT12 +* + LWORK = MAX( ( M+N )*NRHS, + $ ( N+NRHS )*( M+2 ), ( M+NRHS )*( N+2 ), + $ MAX( M+MNMIN, NRHS*MNMIN,2*N+M ), + $ MAX( M*N+4*MNMIN+MAX(M,N), M*N+2*MNMIN+4*N ) ) +* +* Compute workspace needed for DGELS + CALL DGELS( 'N', M, N, NRHS, A, LDA, B, LDB, + $ WORKQUERY, -1, INFO ) + LWORK_DGELS = INT ( WORKQUERY ) +* Compute workspace needed for DGETSLS + CALL DGETSLS( 'N', M, N, NRHS, A, LDA, B, LDB, + $ WORKQUERY, -1, INFO ) + LWORK_DGETSLS = INT( WORKQUERY ) +* Compute workspace needed for DGELSY + CALL DGELSY( M, N, NRHS, A, LDA, B, LDB, IWORKQUERY, + $ RCOND, CRANK, WORKQUERY, -1, INFO ) + LWORK_DGELSY = INT( WORKQUERY ) +* Compute workspace needed for DGELSS + CALL DGELSS( M, N, NRHS, A, LDA, B, LDB, S, + $ RCOND, CRANK, WORKQUERY, -1 , INFO ) + LWORK_DGELSS = INT( WORKQUERY ) +* Compute workspace needed for DGELSD + CALL DGELSD( M, N, NRHS, A, LDA, B, LDB, S, + $ RCOND, CRANK, WORKQUERY, -1, IWORKQUERY, INFO ) + LWORK_DGELSD = INT( WORKQUERY ) +* Compute LIWORK workspace needed for DGELSY and DGELSD + LIWORK = MAX( 1, N, IWORKQUERY ) +* Compute LWORK workspace needed for all functions + LWORK = MAX( 1, LWORK, LWORK_DGELS, LWORK_DGETSLS, LWORK_DGELSY, + $ LWORK_DGELSS, LWORK_DGELSD ) + LWLSY = LWORK +* + ALLOCATE( WORK( LWORK ) ) + ALLOCATE( IWORK( LIWORK ) ) +* DO 150 IM = 1, NM M = MVAL( IM ) LDA = MAX( 1, M ) @@ -311,20 +372,9 @@ MNMIN = MAX(MIN( M, N ),1) LDB = MAX( 1, M, N ) MB = (MNMIN+1) - IF(MNMIN.NE.MB) THEN - LWTS = (((LDB-MB)/(MB-MNMIN))*MNMIN+MNMIN*2)*MB+5 - ELSE - LWTS = 2*MNMIN+5 - END IF * DO 130 INS = 1, NNS NRHS = NSVAL( INS ) - NLVL = MAX( INT( LOG( MAX( ONE, DBLE( MNMIN ) ) / - $ DBLE( SMLSIZ+1 ) ) / LOG( TWO ) ) + 1, 0 ) - LWORK = MAX( 1, ( M+NRHS )*( N+2 ), ( N+NRHS )*( M+2 ), - $ M*N+4*MNMIN+MAX( M, N ), 12*MNMIN+2*MNMIN*SMLSIZ+ - $ 8*MNMIN*NLVL+MNMIN*NRHS+(SMLSIZ+1)**2,LWTS) - $ * DO 120 IRANK = 1, 2 DO 110 ISCALE = 1, 3 @@ -570,11 +620,6 @@ IWORK( J ) = 0 70 CONTINUE * -* Set LWLSY to the adequate value. -* - LWLSY = MAX( 1, MNMIN+2*N+NB*( N+1 ), - $ 2*MNMIN+NB*NRHS ) -* CALL DLACPY( 'Full', M, N, COPYA, LDA, A, LDA ) CALL DLACPY( 'Full', M, NRHS, COPYB, LDB, B, $ LDB ) @@ -768,6 +813,9 @@ 9997 FORMAT( ' TRANS=''', A1,' M=', I5, ', N=', I5, ', NRHS=', I4, $ ', MB=', I4,', NB=', I4,', type', I2, $ ', test(', I2, ')=', G12.5 ) +* + DEALLOCATE( WORK ) + DEALLOCATE( IWORK ) RETURN * * End of DDRVLS diff --git a/TESTING/LIN/dtsqr01.f b/TESTING/LIN/dtsqr01.f index a9ac1635..d8f34cba 100644 --- a/TESTING/LIN/dtsqr01.f +++ b/TESTING/LIN/dtsqr01.f @@ -110,11 +110,12 @@ * .. * .. Local Scalars .. LOGICAL TESTZEROS, TS - INTEGER INFO, J, K, L, LWORK, LT ,MNB + INTEGER INFO, J, K, L, LWORK, TSIZE, MNB DOUBLE PRECISION ANORM, EPS, RESID, CNORM, DNORM * .. * .. Local Arrays .. INTEGER ISEED( 4 ) + DOUBLE PRECISION TQUERY( 5 ), WORKQUERY * .. * .. External Functions .. DOUBLE PRECISION DLAMCH, DLANGE, DLANSY @@ -146,17 +147,11 @@ L = MAX(M,N,1) MNB = MAX ( MB, NB) LWORK = MAX(3,L)*MNB - IF((K.GE.MNB).OR.(MNB.GE.L))THEN - LT=MAX(1,L)*MNB+5 - ELSE - LT=MAX(1,(L-K)/(MNB-K)+1)*L*MNB+5 - END IF - * * Dynamically allocate local arrays * ALLOCATE ( A(M,N), AF(M,N), Q(L,L), R(M,L), RWORK(L), - $ WORK(LWORK), T(LT), C(M,N), CF(M,N), + $ C(M,N), CF(M,N), $ D(N,M), DF(N,M), LQ(L,N) ) * * Put random numbers into A and copy to AF @@ -177,14 +172,34 @@ * * Factor the matrix A in the array AF. * + CALL DGEQR( M, N, AF, M, TQUERY, -1, WORKQUERY, -1, INFO ) + TSIZE = INT( TQUERY( 1 ) ) + LWORK = INT( WORKQUERY ) + CALL DGEMQR( 'L', 'N', M, M, K, AF, M, TQUERY, TSIZE, CF, M, + $ WORKQUERY, -1, INFO) + LWORK = MAX( LWORK, INT( WORKQUERY ) ) + CALL DGEMQR( 'L', 'N', M, N, K, AF, M, TQUERY, TSIZE, CF, M, + $ WORKQUERY, -1, INFO) + LWORK = MAX( LWORK, INT( WORKQUERY ) ) + CALL DGEMQR( 'L', 'T', M, N, K, AF, M, TQUERY, TSIZE, CF, M, + $ WORKQUERY, -1, INFO) + LWORK = MAX( LWORK, INT( WORKQUERY ) ) + CALL DGEMQR( 'R', 'N', N, M, K, AF, M, TQUERY, TSIZE, DF, N, + $ WORKQUERY, -1, INFO) + LWORK = MAX( LWORK, INT( WORKQUERY ) ) + CALL DGEMQR( 'R', 'T', N, M, K, AF, M, TQUERY, TSIZE, DF, N, + $ WORKQUERY, -1, INFO) + LWORK = MAX( LWORK, INT( WORKQUERY ) ) + ALLOCATE ( T( TSIZE ) ) + ALLOCATE ( WORK( LWORK ) ) srnamt = 'DGEQR' - CALL DGEQR( M, N, AF, M, T, LT, WORK, LWORK, INFO ) + CALL DGEQR( M, N, AF, M, T, TSIZE, WORK, LWORK, INFO ) * * Generate the m-by-m matrix Q * CALL DLASET( 'Full', M, M, ZERO, ONE, Q, M ) srnamt = 'DGEMQR' - CALL DGEMQR( 'L', 'N', M, M, K, AF, M, T, LT, Q, M, + CALL DGEMQR( 'L', 'N', M, M, K, AF, M, T, TSIZE, Q, M, $ WORK, LWORK, INFO ) * * Copy R @@ -221,7 +236,7 @@ * Apply Q to C as Q*C * srnamt = 'DGEMQR' - CALL DGEMQR( 'L', 'N', M, N, K, AF, M, T, LT, CF, M, + CALL DGEMQR( 'L', 'N', M, N, K, AF, M, T, TSIZE, CF, M, $ WORK, LWORK, INFO) * * Compute |Q*C - Q*C| / |C| @@ -241,7 +256,7 @@ * Apply Q to C as QT*C * srnamt = 'DGEMQR' - CALL DGEMQR( 'L', 'T', M, N, K, AF, M, T, LT, CF, M, + CALL DGEMQR( 'L', 'T', M, N, K, AF, M, T, TSIZE, CF, M, $ WORK, LWORK, INFO) * * Compute |QT*C - QT*C| / |C| @@ -265,7 +280,7 @@ * Apply Q to D as D*Q * srnamt = 'DGEMQR' - CALL DGEMQR( 'R', 'N', N, M, K, AF, M, T, LT, DF, N, + CALL DGEMQR( 'R', 'N', N, M, K, AF, M, T, TSIZE, DF, N, $ WORK, LWORK, INFO) * * Compute |D*Q - D*Q| / |D| @@ -284,7 +299,7 @@ * * Apply Q to D as D*QT * - CALL DGEMQR( 'R', 'T', N, M, K, AF, M, T, LT, DF, N, + CALL DGEMQR( 'R', 'T', N, M, K, AF, M, T, TSIZE, DF, N, $ WORK, LWORK, INFO) * * Compute |D*QT - D*QT| / |D| @@ -300,15 +315,35 @@ * Short and wide * ELSE + CALL DGELQ( M, N, AF, M, TQUERY, -1, WORKQUERY, -1, INFO ) + TSIZE = INT( TQUERY( 1 ) ) + LWORK = INT( WORKQUERY ) + CALL DGEMLQ( 'R', 'N', N, N, K, AF, M, TQUERY, TSIZE, Q, N, + $ WORKQUERY, -1, INFO ) + LWORK = MAX( LWORK, INT( WORKQUERY ) ) + CALL DGEMLQ( 'L', 'N', N, M, K, AF, M, TQUERY, TSIZE, DF, N, + $ WORKQUERY, -1, INFO) + LWORK = MAX( LWORK, INT( WORKQUERY ) ) + CALL DGEMLQ( 'L', 'T', N, M, K, AF, M, TQUERY, TSIZE, DF, N, + $ WORKQUERY, -1, INFO) + LWORK = MAX( LWORK, INT( WORKQUERY ) ) + CALL DGEMLQ( 'R', 'N', M, N, K, AF, M, TQUERY, TSIZE, CF, M, + $ WORKQUERY, -1, INFO) + LWORK = MAX( LWORK, INT( WORKQUERY ) ) + CALL DGEMLQ( 'R', 'T', M, N, K, AF, M, TQUERY, TSIZE, CF, M, + $ WORKQUERY, -1, INFO) + LWORK = MAX( LWORK, INT( WORKQUERY ) ) + ALLOCATE ( T( TSIZE ) ) + ALLOCATE ( WORK( LWORK ) ) srnamt = 'DGELQ' - CALL DGELQ( M, N, AF, M, T, LT, WORK, LWORK, INFO ) + CALL DGELQ( M, N, AF, M, T, TSIZE, WORK, LWORK, INFO ) * * * Generate the n-by-n matrix Q * CALL DLASET( 'Full', N, N, ZERO, ONE, Q, N ) srnamt = 'DGEMLQ' - CALL DGEMLQ( 'R', 'N', N, N, K, AF, M, T, LT, Q, N, + CALL DGEMLQ( 'R', 'N', N, N, K, AF, M, T, TSIZE, Q, N, $ WORK, LWORK, INFO ) * * Copy R @@ -344,7 +379,7 @@ * * Apply Q to C as Q*C * - CALL DGEMLQ( 'L', 'N', N, M, K, AF, M, T, LT, DF, N, + CALL DGEMLQ( 'L', 'N', N, M, K, AF, M, T, TSIZE, DF, N, $ WORK, LWORK, INFO) * * Compute |Q*D - Q*D| / |D| @@ -363,7 +398,7 @@ * * Apply Q to D as QT*D * - CALL DGEMLQ( 'L', 'T', N, M, K, AF, M, T, LT, DF, N, + CALL DGEMLQ( 'L', 'T', N, M, K, AF, M, T, TSIZE, DF, N, $ WORK, LWORK, INFO) * * Compute |QT*D - QT*D| / |D| @@ -386,7 +421,7 @@ * * Apply Q to C as C*Q * - CALL DGEMLQ( 'R', 'N', M, N, K, AF, M, T, LT, CF, M, + CALL DGEMLQ( 'R', 'N', M, N, K, AF, M, T, TSIZE, CF, M, $ WORK, LWORK, INFO) * * Compute |C*Q - C*Q| / |C| @@ -405,7 +440,7 @@ * * Apply Q to D as D*QT * - CALL DGEMLQ( 'R', 'T', M, N, K, AF, M, T, LT, CF, M, + CALL DGEMLQ( 'R', 'T', M, N, K, AF, M, T, TSIZE, CF, M, $ WORK, LWORK, INFO) * * Compute |C*QT - C*QT| / |C| diff --git a/TESTING/LIN/schkaa.f b/TESTING/LIN/schkaa.f index 675e32f1..410379b3 100644 --- a/TESTING/LIN/schkaa.f +++ b/TESTING/LIN/schkaa.f @@ -904,7 +904,7 @@ CALL SDRVLS( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, NNB, $ NBVAL, NXVAL, THRESH, TSTERR, A( 1, 1 ), $ A( 1, 2 ), B( 1, 1 ), B( 1, 2 ), B( 1, 3 ), - $ RWORK, RWORK( NMAX+1 ), WORK, IWORK, NOUT ) + $ RWORK, RWORK( NMAX+1 ), NOUT ) ELSE WRITE( NOUT, FMT = 9988 )PATH END IF diff --git a/TESTING/LIN/sdrvls.f b/TESTING/LIN/sdrvls.f index 03598937..d6a55708 100644 --- a/TESTING/LIN/sdrvls.f +++ b/TESTING/LIN/sdrvls.f @@ -10,7 +10,7 @@ * * SUBROUTINE SDRVLS( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, NNB, * NBVAL, NXVAL, THRESH, TSTERR, A, COPYA, B, -* COPYB, C, S, COPYS, WORK, IWORK, NOUT ) +* COPYB, C, S, COPYS, NOUT ) * * .. Scalar Arguments .. * LOGICAL TSTERR @@ -19,10 +19,10 @@ * .. * .. Array Arguments .. * LOGICAL DOTYPE( * ) -* INTEGER IWORK( * ), MVAL( * ), NBVAL( * ), NSVAL( * ), +* INTEGER MVAL( * ), NBVAL( * ), NSVAL( * ), * $ NVAL( * ), NXVAL( * ) * REAL A( * ), B( * ), C( * ), COPYA( * ), COPYB( * ), -* $ COPYS( * ), S( * ), WORK( * ) +* $ COPYS( * ), S( * ) * .. * * @@ -169,17 +169,6 @@ *> (min(MMAX,NMAX)) *> \endverbatim *> -*> \param[out] WORK -*> \verbatim -*> WORK is REAL array, -*> dimension (MMAX*NMAX + 4*NMAX + MMAX). -*> \endverbatim -*> -*> \param[out] IWORK -*> \verbatim -*> IWORK is INTEGER array, dimension (15*NMAX) -*> \endverbatim -*> *> \param[in] NOUT *> \verbatim *> NOUT is INTEGER @@ -201,7 +190,7 @@ * ===================================================================== SUBROUTINE SDRVLS( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, NNB, $ NBVAL, NXVAL, THRESH, TSTERR, A, COPYA, B, - $ COPYB, C, S, COPYS, WORK, IWORK, NOUT ) + $ COPYB, C, S, COPYS, NOUT ) * * -- LAPACK test routine (version 3.6.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -215,10 +204,10 @@ * .. * .. Array Arguments .. LOGICAL DOTYPE( * ) - INTEGER IWORK( * ), MVAL( * ), NBVAL( * ), NSVAL( * ), + INTEGER MVAL( * ), NBVAL( * ), NSVAL( * ), $ NVAL( * ), NXVAL( * ) REAL A( * ), B( * ), C( * ), COPYA( * ), COPYB( * ), - $ COPYS( * ), S( * ), WORK( * ) + $ COPYS( * ), S( * ) * .. * * ===================================================================== @@ -237,12 +226,19 @@ INTEGER CRANK, I, IM, IMB, IN, INB, INFO, INS, IRANK, $ ISCALE, ITRAN, ITYPE, J, K, LDA, LDB, LDWORK, $ LWLSY, LWORK, M, MNMIN, N, NB, NCOLS, NERRS, - $ NFAIL, NLVL, NRHS, NROWS, NRUN, RANK, MB, LWTS + $ NFAIL, NRHS, NROWS, NRUN, RANK, MB, + $ MMAX, NMAX, NSMAX, LIWORK, + $ LWORK_SGELS, LWORK_SGETSLS, LWORK_SGELSS, + $ LWORK_SGELSY, LWORK_SGELSD REAL EPS, NORMA, NORMB, RCOND * .. * .. Local Arrays .. - INTEGER ISEED( 4 ), ISEEDY( 4 ) - REAL RESULT( NTESTS ) + INTEGER ISEED( 4 ), ISEEDY( 4 ), IWORKQUERY + REAL RESULT( NTESTS ), WORKQUERY +* .. +* .. Allocatable Arrays .. + REAL, ALLOCATABLE :: WORK (:) + INTEGER, ALLOCATABLE :: IWORK (:) * .. * .. External Functions .. REAL SASUM, SLAMCH, SQRT12, SQRT14, SQRT17 @@ -302,6 +298,71 @@ CALL XLAENV( 2, 2 ) CALL XLAENV( 9, SMLSIZ ) * +* Compute maximal workspace needed for all routines +* + NMAX = 0 + MMAX = 0 + NSMAX = 0 + DO I = 1, NM + IF ( MVAL( I ).GT.MMAX ) THEN + MMAX = MVAL( I ) + END IF + ENDDO + DO I = 1, NN + IF ( NVAL( I ).GT.NMAX ) THEN + NMAX = NVAL( I ) + END IF + ENDDO + DO I = 1, NNS + IF ( NSVAL( I ).GT.NSMAX ) THEN + NSMAX = NSVAL( I ) + END IF + ENDDO + M = MMAX + N = NMAX + NRHS = NSMAX + LDA = MAX( 1, M ) + LDB = MAX( 1, M, N ) + MNMIN = MAX( MIN( M, N ), 1 ) +* +* Compute workspace needed for routines +* SQRT14, SQRT17 (two side cases), SQRT15 and SQRT12 +* + LWORK = MAX( ( M+N )*NRHS, + $ ( N+NRHS )*( M+2 ), ( M+NRHS )*( N+2 ), + $ MAX( M+MNMIN, NRHS*MNMIN,2*N+M ), + $ MAX( M*N+4*MNMIN+MAX(M,N), M*N+2*MNMIN+4*N ) ) +* +* Compute workspace needed for SGELS + CALL SGELS( 'N', M, N, NRHS, A, LDA, B, LDB, + $ WORKQUERY, -1, INFO ) + LWORK_SGELS = INT ( WORKQUERY ) +* Compute workspace needed for SGETSLS + CALL SGETSLS( 'N', M, N, NRHS, A, LDA, B, LDB, + $ WORKQUERY, -1, INFO ) + LWORK_SGETSLS = INT( WORKQUERY ) +* Compute workspace needed for SGELSY + CALL SGELSY( M, N, NRHS, A, LDA, B, LDB, IWORKQUERY, + $ RCOND, CRANK, WORKQUERY, -1, INFO ) + LWORK_SGELSY = INT( WORKQUERY ) +* Compute workspace needed for SGELSS + CALL SGELSS( M, N, NRHS, A, LDA, B, LDB, S, + $ RCOND, CRANK, WORKQUERY, -1 , INFO ) + LWORK_SGELSS = INT( WORKQUERY ) +* Compute workspace needed for SGELSD + CALL SGELSD( M, N, NRHS, A, LDA, B, LDB, S, + $ RCOND, CRANK, WORKQUERY, -1, IWORKQUERY, INFO ) + LWORK_SGELSD = INT( WORKQUERY ) +* Compute LIWORK workspace needed for SGELSY and SGELSD + LIWORK = MAX( 1, N, IWORKQUERY ) +* Compute LWORK workspace needed for all functions + LWORK = MAX( 1, LWORK, LWORK_SGELS, LWORK_SGETSLS, LWORK_SGELSY, + $ LWORK_SGELSS, LWORK_SGELSD ) + LWLSY = LWORK +* + ALLOCATE( WORK( LWORK ) ) + ALLOCATE( IWORK( LIWORK ) ) +* DO 150 IM = 1, NM M = MVAL( IM ) LDA = MAX( 1, M ) @@ -311,20 +372,9 @@ MNMIN = MAX(MIN( M, N ),1) LDB = MAX( 1, M, N ) MB = (MNMIN+1) - IF(MNMIN.NE.MB) THEN - LWTS = (((LDB-MB)/(MB-MNMIN))*MNMIN+MNMIN*2)*MB+5 - ELSE - LWTS = 2*MNMIN+5 - END IF * DO 130 INS = 1, NNS NRHS = NSVAL( INS ) - NLVL = MAX( INT( LOG( MAX( ONE, REAL( MNMIN ) ) / - $ REAL( SMLSIZ+1 ) ) / LOG( TWO ) ) + 1, 0 ) - LWORK = MAX( 1, ( M+NRHS )*( N+2 ), ( N+NRHS )*( M+2 ), - $ M*N+4*MNMIN+MAX( M, N ), 12*MNMIN+2*MNMIN*SMLSIZ+ - $ 8*MNMIN*NLVL+MNMIN*NRHS+(SMLSIZ+1)**2,LWTS) - $ * DO 120 IRANK = 1, 2 DO 110 ISCALE = 1, 3 @@ -570,11 +620,6 @@ IWORK( J ) = 0 70 CONTINUE * -* Set LWLSY to the adequate value. -* - LWLSY = MAX( 1, MNMIN+2*N+NB*( N+1 ), - $ 2*MNMIN+NB*NRHS ) -* CALL SLACPY( 'Full', M, N, COPYA, LDA, A, LDA ) CALL SLACPY( 'Full', M, NRHS, COPYB, LDB, B, $ LDB ) @@ -768,6 +813,9 @@ 9997 FORMAT( ' TRANS=''', A1,' M=', I5, ', N=', I5, ', NRHS=', I4, $ ', MB=', I4,', NB=', I4,', type', I2, $ ', test(', I2, ')=', G12.5 ) +* + DEALLOCATE( WORK ) + DEALLOCATE( IWORK ) RETURN * * End of SDRVLS diff --git a/TESTING/LIN/stsqr01.f b/TESTING/LIN/stsqr01.f index 4cebfc88..3e4e3d09 100644 --- a/TESTING/LIN/stsqr01.f +++ b/TESTING/LIN/stsqr01.f @@ -110,11 +110,12 @@ * .. * .. Local Scalars .. LOGICAL TESTZEROS, TS - INTEGER INFO, J, K, L, LWORK, LT ,MNB + INTEGER INFO, J, K, L, LWORK, TSIZE, MNB REAL ANORM, EPS, RESID, CNORM, DNORM * .. * .. Local Arrays .. INTEGER ISEED( 4 ) + REAL TQUERY( 5 ), WORKQUERY * .. * .. External Functions .. REAL SLAMCH, SLANGE, SLANSY @@ -146,17 +147,11 @@ L = MAX(M,N,1) MNB = MAX ( MB, NB) LWORK = MAX(3,L)*MNB - IF((K.GE.MNB).OR.(MNB.GE.L))THEN - LT=MAX(1,L)*MNB+5 - ELSE - LT=MAX(1,(L-K)/(MNB-K)+1)*L*MNB+5 - END IF - * * Dynamically allocate local arrays * ALLOCATE ( A(M,N), AF(M,N), Q(L,L), R(M,L), RWORK(L), - $ WORK(LWORK), T(LT), C(M,N), CF(M,N), + $ C(M,N), CF(M,N), $ D(N,M), DF(N,M), LQ(L,N) ) * * Put random numbers into A and copy to AF @@ -177,14 +172,34 @@ * * Factor the matrix A in the array AF. * + CALL SGEQR( M, N, AF, M, TQUERY, -1, WORKQUERY, -1, INFO ) + TSIZE = INT( TQUERY( 1 ) ) + LWORK = INT( WORKQUERY ) + CALL SGEMQR( 'L', 'N', M, M, K, AF, M, TQUERY, TSIZE, CF, M, + $ WORKQUERY, -1, INFO) + LWORK = MAX( LWORK, INT( WORKQUERY ) ) + CALL SGEMQR( 'L', 'N', M, N, K, AF, M, TQUERY, TSIZE, CF, M, + $ WORKQUERY, -1, INFO) + LWORK = MAX( LWORK, INT( WORKQUERY ) ) + CALL SGEMQR( 'L', 'T', M, N, K, AF, M, TQUERY, TSIZE, CF, M, + $ WORKQUERY, -1, INFO) + LWORK = MAX( LWORK, INT( WORKQUERY ) ) + CALL SGEMQR( 'R', 'N', N, M, K, AF, M, TQUERY, TSIZE, DF, N, + $ WORKQUERY, -1, INFO) + LWORK = MAX( LWORK, INT( WORKQUERY ) ) + CALL SGEMQR( 'R', 'T', N, M, K, AF, M, TQUERY, TSIZE, DF, N, + $ WORKQUERY, -1, INFO) + LWORK = MAX( LWORK, INT( WORKQUERY ) ) + ALLOCATE ( T( TSIZE ) ) + ALLOCATE ( WORK( LWORK ) ) srnamt = 'SGEQR' - CALL SGEQR( M, N, AF, M, T, LT, WORK, LWORK, INFO ) + CALL SGEQR( M, N, AF, M, T, TSIZE, WORK, LWORK, INFO ) * * Generate the m-by-m matrix Q * CALL SLASET( 'Full', M, M, ZERO, ONE, Q, M ) srnamt = 'SGEMQR' - CALL SGEMQR( 'L', 'N', M, M, K, AF, M, T, LT, Q, M, + CALL SGEMQR( 'L', 'N', M, M, K, AF, M, T, TSIZE, Q, M, $ WORK, LWORK, INFO ) * * Copy R @@ -221,7 +236,7 @@ * Apply Q to C as Q*C * srnamt = 'DGEQR' - CALL SGEMQR( 'L', 'N', M, N, K, AF, M, T, LT, CF, M, + CALL SGEMQR( 'L', 'N', M, N, K, AF, M, T, TSIZE, CF, M, $ WORK, LWORK, INFO) * * Compute |Q*C - Q*C| / |C| @@ -241,7 +256,7 @@ * Apply Q to C as QT*C * srnamt = 'DGEQR' - CALL SGEMQR( 'L', 'T', M, N, K, AF, M, T, LT, CF, M, + CALL SGEMQR( 'L', 'T', M, N, K, AF, M, T, TSIZE, CF, M, $ WORK, LWORK, INFO) * * Compute |QT*C - QT*C| / |C| @@ -265,7 +280,7 @@ * Apply Q to D as D*Q * srnamt = 'DGEQR' - CALL SGEMQR( 'R', 'N', N, M, K, AF, M, T, LT, DF, N, + CALL SGEMQR( 'R', 'N', N, M, K, AF, M, T, TSIZE, DF, N, $ WORK, LWORK, INFO) * * Compute |D*Q - D*Q| / |D| @@ -284,7 +299,7 @@ * * Apply Q to D as D*QT * - CALL SGEMQR( 'R', 'T', N, M, K, AF, M, T, LT, DF, N, + CALL SGEMQR( 'R', 'T', N, M, K, AF, M, T, TSIZE, DF, N, $ WORK, LWORK, INFO) * * Compute |D*QT - D*QT| / |D| @@ -300,15 +315,35 @@ * Short and wide * ELSE + CALL SGELQ( M, N, AF, M, TQUERY, -1, WORKQUERY, -1, INFO ) + TSIZE = INT( TQUERY( 1 ) ) + LWORK = INT( WORKQUERY ) + CALL SGEMLQ( 'R', 'N', N, N, K, AF, M, TQUERY, TSIZE, Q, N, + $ WORKQUERY, -1, INFO ) + LWORK = MAX( LWORK, INT( WORKQUERY ) ) + CALL SGEMLQ( 'L', 'N', N, M, K, AF, M, TQUERY, TSIZE, DF, N, + $ WORKQUERY, -1, INFO) + LWORK = MAX( LWORK, INT( WORKQUERY ) ) + CALL SGEMLQ( 'L', 'T', N, M, K, AF, M, TQUERY, TSIZE, DF, N, + $ WORKQUERY, -1, INFO) + LWORK = MAX( LWORK, INT( WORKQUERY ) ) + CALL SGEMLQ( 'R', 'N', M, N, K, AF, M, TQUERY, TSIZE, CF, M, + $ WORKQUERY, -1, INFO) + LWORK = MAX( LWORK, INT( WORKQUERY ) ) + CALL SGEMLQ( 'R', 'T', M, N, K, AF, M, TQUERY, TSIZE, CF, M, + $ WORKQUERY, -1, INFO) + LWORK = MAX( LWORK, INT( WORKQUERY ) ) + ALLOCATE ( T( TSIZE ) ) + ALLOCATE ( WORK( LWORK ) ) srnamt = 'SGELQ' - CALL SGELQ( M, N, AF, M, T, LT, WORK, LWORK, INFO ) + CALL SGELQ( M, N, AF, M, T, TSIZE, WORK, LWORK, INFO ) * * * Generate the n-by-n matrix Q * CALL SLASET( 'Full', N, N, ZERO, ONE, Q, N ) - srnamt = 'SGEMQR' - CALL SGEMLQ( 'R', 'N', N, N, K, AF, M, T, LT, Q, N, + srnamt = 'SGEMLQ' + CALL SGEMLQ( 'R', 'N', N, N, K, AF, M, T, TSIZE, Q, N, $ WORK, LWORK, INFO ) * * Copy R @@ -344,7 +379,7 @@ * * Apply Q to C as Q*C * - CALL SGEMLQ( 'L', 'N', N, M, K, AF, M, T, LT, DF, N, + CALL SGEMLQ( 'L', 'N', N, M, K, AF, M, T, TSIZE, DF, N, $ WORK, LWORK, INFO) * * Compute |Q*D - Q*D| / |D| @@ -363,7 +398,7 @@ * * Apply Q to D as QT*D * - CALL SGEMLQ( 'L', 'T', N, M, K, AF, M, T, LT, DF, N, + CALL SGEMLQ( 'L', 'T', N, M, K, AF, M, T, TSIZE, DF, N, $ WORK, LWORK, INFO) * * Compute |QT*D - QT*D| / |D| @@ -386,7 +421,7 @@ * * Apply Q to C as C*Q * - CALL SGEMLQ( 'R', 'N', M, N, K, AF, M, T, LT, CF, M, + CALL SGEMLQ( 'R', 'N', M, N, K, AF, M, T, TSIZE, CF, M, $ WORK, LWORK, INFO) * * Compute |C*Q - C*Q| / |C| @@ -405,7 +440,7 @@ * * Apply Q to D as D*QT * - CALL SGEMLQ( 'R', 'T', M, N, K, AF, M, T, LT, CF, M, + CALL SGEMLQ( 'R', 'T', M, N, K, AF, M, T, TSIZE, CF, M, $ WORK, LWORK, INFO) * * Compute |C*QT - C*QT| / |C| diff --git a/TESTING/LIN/zchkaa.f b/TESTING/LIN/zchkaa.f index 818f1e63..5a41ab32 100644 --- a/TESTING/LIN/zchkaa.f +++ b/TESTING/LIN/zchkaa.f @@ -1049,8 +1049,7 @@ CALL ZDRVLS( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, NNB, $ NBVAL, NXVAL, THRESH, TSTERR, A( 1, 1 ), $ A( 1, 2 ), A( 1, 3 ), A( 1, 4 ), A( 1, 5 ), - $ S( 1 ), S( NMAX+1 ), WORK, RWORK, IWORK, - $ NOUT ) + $ S( 1 ), S( NMAX+1 ), NOUT ) ELSE WRITE( NOUT, FMT = 9989 )PATH END IF diff --git a/TESTING/LIN/zdrvls.f b/TESTING/LIN/zdrvls.f index fe63b540..13a9263e 100644 --- a/TESTING/LIN/zdrvls.f +++ b/TESTING/LIN/zdrvls.f @@ -10,7 +10,7 @@ * * SUBROUTINE ZDRVLS( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, NNB, * NBVAL, NXVAL, THRESH, TSTERR, A, COPYA, B, -* COPYB, C, S, COPYS, WORK, RWORK, IWORK, NOUT ) +* COPYB, C, S, COPYS, NOUT ) * * .. Scalar Arguments .. * LOGICAL TSTERR @@ -19,11 +19,10 @@ * .. * .. Array Arguments .. * LOGICAL DOTYPE( * ) -* INTEGER IWORK( * ), MVAL( * ), NBVAL( * ), NSVAL( * ), +* INTEGER MVAL( * ), NBVAL( * ), NSVAL( * ), * $ NVAL( * ), NXVAL( * ) -* DOUBLE PRECISION COPYS( * ), RWORK( * ), S( * ) -* COMPLEX*16 A( * ), B( * ), C( * ), COPYA( * ), COPYB( * ), -* $ WORK( * ) +* DOUBLE PRECISION COPYS( * ), S( * ) +* COMPLEX*16 A( * ), B( * ), C( * ), COPYA( * ), COPYB( * ) * .. * * @@ -32,8 +31,8 @@ *> *> \verbatim *> -*> ZDRVLS tests the least squares driver routines ZGELS, CGELSS, ZGELSY -*> and CGELSD. +*> ZDRVLS tests the least squares driver routines ZGELS, ZGETSLS, ZGELSS, ZGELSY +*> and ZGELSD. *> \endverbatim * * Arguments: @@ -170,22 +169,6 @@ *> (min(MMAX,NMAX)) *> \endverbatim *> -*> \param[out] WORK -*> \verbatim -*> WORK is COMPLEX*16 array, dimension -*> (MMAX*NMAX + 4*NMAX + MMAX). -*> \endverbatim -*> -*> \param[out] RWORK -*> \verbatim -*> RWORK is DOUBLE PRECISION array, dimension (5*NMAX-1) -*> \endverbatim -*> -*> \param[out] IWORK -*> \verbatim -*> IWORK is INTEGER array, dimension (15*NMAX) -*> \endverbatim -*> *> \param[in] NOUT *> \verbatim *> NOUT is INTEGER @@ -207,7 +190,7 @@ * ===================================================================== SUBROUTINE ZDRVLS( DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, NNB, $ NBVAL, NXVAL, THRESH, TSTERR, A, COPYA, B, - $ COPYB, C, S, COPYS, WORK, RWORK, IWORK, NOUT ) + $ COPYB, C, S, COPYS, NOUT ) * * -- LAPACK test routine (version 3.6.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -221,11 +204,10 @@ * .. * .. Array Arguments .. LOGICAL DOTYPE( * ) - INTEGER IWORK( * ), MVAL( * ), NBVAL( * ), NSVAL( * ), + INTEGER MVAL( * ), NBVAL( * ), NSVAL( * ), $ NVAL( * ), NXVAL( * ) - DOUBLE PRECISION COPYS( * ), RWORK( * ), S( * ) - COMPLEX*16 A( * ), B( * ), C( * ), COPYA( * ), COPYB( * ), - $ WORK( * ) + DOUBLE PRECISION COPYS( * ), S( * ) + COMPLEX*16 A( * ), B( * ), C( * ), COPYA( * ), COPYB( * ) * .. * * ===================================================================== @@ -247,12 +229,22 @@ INTEGER CRANK, I, IM, IMB, IN, INB, INFO, INS, IRANK, $ ISCALE, ITRAN, ITYPE, J, K, LDA, LDB, LDWORK, $ LWLSY, LWORK, M, MNMIN, N, NB, NCOLS, NERRS, - $ NFAIL, NRHS, NROWS, NRUN, RANK, MB, LWTS + $ NFAIL, NRHS, NROWS, NRUN, RANK, MB, + $ MMAX, NMAX, NSMAX, LIWORK, LRWORK, + $ LWORK_ZGELS, LWORK_ZGETSLS, LWORK_ZGELSS, + $ LWORK_ZGELSY, LWORK_ZGELSD, + $ LRWORK_ZGELSY, LRWORK_ZGELSS, LRWORK_ZGELSD DOUBLE PRECISION EPS, NORMA, NORMB, RCOND * .. * .. Local Arrays .. - INTEGER ISEED( 4 ), ISEEDY( 4 ) - DOUBLE PRECISION RESULT( NTESTS ) + INTEGER ISEED( 4 ), ISEEDY( 4 ), IWORKQUERY + DOUBLE PRECISION RESULT( NTESTS ), RWORKQUERY + COMPLEX*16 WORKQUERY +* .. +* .. Allocatable Arrays .. + COMPLEX*16, ALLOCATABLE :: WORK (:) + DOUBLE PRECISION, ALLOCATABLE :: RWORK (:) + INTEGER, ALLOCATABLE :: IWORK (:) * .. * .. External Functions .. DOUBLE PRECISION DASUM, DLAMCH, ZQRT12, ZQRT14, ZQRT17 @@ -265,7 +257,7 @@ $ ZQRT16, ZGETSLS * .. * .. Intrinsic Functions .. - INTRINSIC DBLE, MAX, MIN, SQRT + INTRINSIC DBLE, MAX, MIN, INT, SQRT * .. * .. Scalars in Common .. LOGICAL LERR, OK @@ -309,6 +301,77 @@ $ CALL ALAHD( NOUT, PATH ) INFOT = 0 * +* Compute maximal workspace needed for all routines +* + NMAX = 0 + MMAX = 0 + NSMAX = 0 + DO I = 1, NM + IF ( MVAL( I ).GT.MMAX ) THEN + MMAX = MVAL( I ) + END IF + ENDDO + DO I = 1, NN + IF ( NVAL( I ).GT.NMAX ) THEN + NMAX = NVAL( I ) + END IF + ENDDO + DO I = 1, NNS + IF ( NSVAL( I ).GT.NSMAX ) THEN + NSMAX = NSVAL( I ) + END IF + ENDDO + M = MMAX + N = NMAX + NRHS = NSMAX + LDA = MAX( 1, M ) + LDB = MAX( 1, M, N ) + MNMIN = MAX( MIN( M, N ), 1 ) +* +* Compute workspace needed for routines +* ZQRT14, ZQRT17 (two side cases), ZQRT15 and ZQRT12 +* + LWORK = MAX( ( M+N )*NRHS, + $ ( N+NRHS )*( M+2 ), ( M+NRHS )*( N+2 ), + $ MAX( M+MNMIN, NRHS*MNMIN,2*N+M ), + $ MAX( M*N+4*MNMIN+MAX(M,N), M*N+2*MNMIN+4*N ) ) +* +* Compute workspace needed for ZGELS + CALL ZGELS( 'N', M, N, NRHS, A, LDA, B, LDB, + $ WORKQUERY, -1, INFO ) + LWORK_ZGELS = INT ( WORKQUERY ) +* Compute workspace needed for ZGETSLS + CALL ZGETSLS( 'N', M, N, NRHS, A, LDA, B, LDB, + $ WORKQUERY, -1, INFO ) + LWORK_ZGETSLS = INT( WORKQUERY ) +* Compute workspace needed for ZGELSY + CALL ZGELSY( M, N, NRHS, A, LDA, B, LDB, IWORKQUERY, + $ RCOND, CRANK, WORKQUERY, -1, RWORK, INFO ) + LWORK_ZGELSY = INT( WORKQUERY ) + LRWORK_ZGELSY = 2*N +* Compute workspace needed for ZGELSS + CALL ZGELSS( M, N, NRHS, A, LDA, B, LDB, S, + $ RCOND, CRANK, WORKQUERY, -1 , RWORK, INFO ) + LWORK_ZGELSS = INT( WORKQUERY ) + LRWORK_ZGELSS = 5*MNMIN +* Compute workspace needed for ZGELSD + CALL ZGELSD( M, N, NRHS, A, LDA, B, LDB, S, RCOND, CRANK, + $ WORKQUERY, -1, RWORKQUERY, IWORKQUERY, INFO ) + LWORK_ZGELSD = INT( WORKQUERY ) + LRWORK_ZGELSD = INT( RWORKQUERY ) +* Compute LIWORK workspace needed for ZGELSY and ZGELSD + LIWORK = MAX( 1, N, IWORKQUERY ) +* Compute LRWORK workspace needed for ZGELSY, ZGELSS and ZGELSD + LRWORK = MAX( 1, LRWORK_ZGELSY, LRWORK_ZGELSS, LRWORK_ZGELSD ) +* Compute LWORK workspace needed for all functions + LWORK = MAX( 1, LWORK, LWORK_ZGELS, LWORK_ZGETSLS, LWORK_ZGELSY, + $ LWORK_ZGELSS, LWORK_ZGELSD ) + LWLSY = LWORK +* + ALLOCATE( WORK( LWORK ) ) + ALLOCATE( IWORK( LIWORK ) ) + ALLOCATE( RWORK( LRWORK ) ) +* DO 140 IM = 1, NM M = MVAL( IM ) LDA = MAX( 1, M ) @@ -318,16 +381,9 @@ MNMIN = MAX(MIN( M, N ),1) LDB = MAX( 1, M, N ) MB = (MNMIN+1) - IF(MNMIN.NE.MB) THEN - LWTS = (((LDB-MB)/(MB-MNMIN))*MNMIN+LDB*2)*MB+5 - ELSE - LWTS = 2*MNMIN+5 - END IF * DO 120 INS = 1, NNS NRHS = NSVAL( INS ) - LWORK = MAX( 1, ( M+NRHS )*( N+2 ), ( N+NRHS )*( M+2 ), - $ M*N+4*MNMIN+MAX( M, N ), 2*N+M, LWTS ) * DO 110 IRANK = 1, 2 DO 100 ISCALE = 1, 3 @@ -578,12 +634,6 @@ IWORK( J ) = 0 70 CONTINUE * -* Set LWLSY to the adequate value. -* - LWLSY = MNMIN + MAX( 2*MNMIN, NB*( N+1 ), - $ MNMIN+NB*NRHS ) - LWLSY = MAX( 1, LWLSY ) -* SRNAMT = 'ZGELSY' CALL ZGELSY( M, N, NRHS, A, LDA, B, LDB, IWORK, $ RCOND, CRANK, WORK, LWLSY, RWORK, @@ -774,6 +824,10 @@ 9997 FORMAT( ' TRANS=''', A1,' M=', I5, ', N=', I5, ', NRHS=', I4, $ ', MB=', I4,', NB=', I4,', type', I2, $ ', test(', I2, ')=', G12.5 ) +* + DEALLOCATE( WORK ) + DEALLOCATE( IWORK ) + DEALLOCATE( RWORK ) RETURN * * End of ZDRVLS diff --git a/TESTING/LIN/ztsqr01.f b/TESTING/LIN/ztsqr01.f index 38ace9c8..acc027e0 100644 --- a/TESTING/LIN/ztsqr01.f +++ b/TESTING/LIN/ztsqr01.f @@ -109,11 +109,12 @@ * .. * .. Local Scalars .. LOGICAL TESTZEROS, TS - INTEGER INFO, J, K, L, LWORK, LT ,MNB + INTEGER INFO, J, K, L, LWORK, TSIZE, MNB DOUBLE PRECISION ANORM, EPS, RESID, CNORM, DNORM * .. * .. Local Arrays .. INTEGER ISEED( 4 ) + COMPLEX*16 TQUERY( 5 ), WORKQUERY * .. * .. External Functions .. DOUBLE PRECISION DLAMCH, ZLANGE, ZLANSY @@ -145,17 +146,11 @@ L = MAX(M,N,1) MNB = MAX ( MB, NB) LWORK = MAX(3,L)*MNB - IF((K.GE.MNB).OR.(MNB.GE.L))THEN - LT=MAX(1,L)*MNB+5 - ELSE - LT=MAX(1,(L-K)/(MNB-K)+1)*L*MNB+5 - END IF - * * Dynamically allocate local arrays * ALLOCATE ( A(M,N), AF(M,N), Q(L,L), R(M,L), RWORK(L), - $ WORK(LWORK), T(LT), C(M,N), CF(M,N), + $ C(M,N), CF(M,N), $ D(N,M), DF(N,M), LQ(L,N) ) * * Put random numbers into A and copy to AF @@ -176,14 +171,34 @@ * * Factor the matrix A in the array AF. * + CALL ZGEQR( M, N, AF, M, TQUERY, -1, WORKQUERY, -1, INFO ) + TSIZE = INT( TQUERY( 1 ) ) + LWORK = INT( WORKQUERY ) + CALL ZGEMQR( 'L', 'N', M, M, K, AF, M, TQUERY, TSIZE, CF, M, + $ WORKQUERY, -1, INFO) + LWORK = MAX( LWORK, INT( WORKQUERY ) ) + CALL ZGEMQR( 'L', 'N', M, N, K, AF, M, TQUERY, TSIZE, CF, M, + $ WORKQUERY, -1, INFO) + LWORK = MAX( LWORK, INT( WORKQUERY ) ) + CALL ZGEMQR( 'L', 'C', M, N, K, AF, M, TQUERY, TSIZE, CF, M, + $ WORKQUERY, -1, INFO) + LWORK = MAX( LWORK, INT( WORKQUERY ) ) + CALL ZGEMQR( 'R', 'N', N, M, K, AF, M, TQUERY, TSIZE, DF, N, + $ WORKQUERY, -1, INFO) + LWORK = MAX( LWORK, INT( WORKQUERY ) ) + CALL ZGEMQR( 'R', 'C', N, M, K, AF, M, TQUERY, TSIZE, DF, N, + $ WORKQUERY, -1, INFO) + LWORK = MAX( LWORK, INT( WORKQUERY ) ) + ALLOCATE ( T( TSIZE ) ) + ALLOCATE ( WORK( LWORK ) ) srnamt = 'ZGEQR' - CALL ZGEQR( M, N, AF, M, T, LT, WORK, LWORK, INFO ) + CALL ZGEQR( M, N, AF, M, T, TSIZE, WORK, LWORK, INFO ) * * Generate the m-by-m matrix Q * CALL ZLASET( 'Full', M, M, CZERO, ONE, Q, M ) srnamt = 'ZGEMQR' - CALL ZGEMQR( 'L', 'N', M, M, K, AF, M, T, LT, Q, M, + CALL ZGEMQR( 'L', 'N', M, M, K, AF, M, T, TSIZE, Q, M, $ WORK, LWORK, INFO ) * * Copy R @@ -220,7 +235,7 @@ * Apply Q to C as Q*C * srnamt = 'ZGEMQR' - CALL ZGEMQR( 'L', 'N', M, N, K, AF, M, T, LT, CF, M, + CALL ZGEMQR( 'L', 'N', M, N, K, AF, M, T, TSIZE, CF, M, $ WORK, LWORK, INFO) * * Compute |Q*C - Q*C| / |C| @@ -240,7 +255,7 @@ * Apply Q to C as QT*C * srnamt = 'ZGEMQR' - CALL ZGEMQR( 'L', 'C', M, N, K, AF, M, T, LT, CF, M, + CALL ZGEMQR( 'L', 'C', M, N, K, AF, M, T, TSIZE, CF, M, $ WORK, LWORK, INFO) * * Compute |QT*C - QT*C| / |C| @@ -264,7 +279,7 @@ * Apply Q to D as D*Q * srnamt = 'ZGEMQR' - CALL ZGEMQR( 'R', 'N', N, M, K, AF, M, T, LT, DF, N, + CALL ZGEMQR( 'R', 'N', N, M, K, AF, M, T, TSIZE, DF, N, $ WORK, LWORK, INFO) * * Compute |D*Q - D*Q| / |D| @@ -283,7 +298,7 @@ * * Apply Q to D as D*QT * - CALL ZGEMQR( 'R', 'C', N, M, K, AF, M, T, LT, DF, N, + CALL ZGEMQR( 'R', 'C', N, M, K, AF, M, T, TSIZE, DF, N, $ WORK, LWORK, INFO) * * Compute |D*QT - D*QT| / |D| @@ -299,15 +314,35 @@ * Short and wide * ELSE + CALL ZGELQ( M, N, AF, M, TQUERY, -1, WORKQUERY, -1, INFO ) + TSIZE = INT( TQUERY( 1 ) ) + LWORK = INT( WORKQUERY ) + CALL ZGEMLQ( 'R', 'N', N, N, K, AF, M, TQUERY, TSIZE, Q, N, + $ WORKQUERY, -1, INFO ) + LWORK = MAX( LWORK, INT( WORKQUERY ) ) + CALL ZGEMLQ( 'L', 'N', N, M, K, AF, M, TQUERY, TSIZE, DF, N, + $ WORKQUERY, -1, INFO) + LWORK = MAX( LWORK, INT( WORKQUERY ) ) + CALL ZGEMLQ( 'L', 'C', N, M, K, AF, M, TQUERY, TSIZE, DF, N, + $ WORKQUERY, -1, INFO) + LWORK = MAX( LWORK, INT( WORKQUERY ) ) + CALL ZGEMLQ( 'R', 'N', M, N, K, AF, M, TQUERY, TSIZE, CF, M, + $ WORKQUERY, -1, INFO) + LWORK = MAX( LWORK, INT( WORKQUERY ) ) + CALL ZGEMLQ( 'R', 'C', M, N, K, AF, M, TQUERY, TSIZE, CF, M, + $ WORKQUERY, -1, INFO) + LWORK = MAX( LWORK, INT( WORKQUERY ) ) + ALLOCATE ( T( TSIZE ) ) + ALLOCATE ( WORK( LWORK ) ) srnamt = 'ZGELQ' - CALL ZGELQ( M, N, AF, M, T, LT, WORK, LWORK, INFO ) + CALL ZGELQ( M, N, AF, M, T, TSIZE, WORK, LWORK, INFO ) * * * Generate the n-by-n matrix Q * CALL ZLASET( 'Full', N, N, CZERO, ONE, Q, N ) srnamt = 'ZGEMLQ' - CALL ZGEMLQ( 'R', 'N', N, N, K, AF, M, T, LT, Q, N, + CALL ZGEMLQ( 'R', 'N', N, N, K, AF, M, T, TSIZE, Q, N, $ WORK, LWORK, INFO ) * * Copy R @@ -343,7 +378,7 @@ * * Apply Q to C as Q*C * - CALL ZGEMLQ( 'L', 'N', N, M, K, AF, M, T, LT, DF, N, + CALL ZGEMLQ( 'L', 'N', N, M, K, AF, M, T, TSIZE, DF, N, $ WORK, LWORK, INFO) * * Compute |Q*D - Q*D| / |D| @@ -362,7 +397,7 @@ * * Apply Q to D as QT*D * - CALL ZGEMLQ( 'L', 'C', N, M, K, AF, M, T, LT, DF, N, + CALL ZGEMLQ( 'L', 'C', N, M, K, AF, M, T, TSIZE, DF, N, $ WORK, LWORK, INFO) * * Compute |QT*D - QT*D| / |D| @@ -385,7 +420,7 @@ * * Apply Q to C as C*Q * - CALL ZGEMLQ( 'R', 'N', M, N, K, AF, M, T, LT, CF, M, + CALL ZGEMLQ( 'R', 'N', M, N, K, AF, M, T, TSIZE, CF, M, $ WORK, LWORK, INFO) * * Compute |C*Q - C*Q| / |C| @@ -404,7 +439,7 @@ * * Apply Q to D as D*QT * - CALL ZGEMLQ( 'R', 'C', M, N, K, AF, M, T, LT, CF, M, + CALL ZGEMLQ( 'R', 'C', M, N, K, AF, M, T, TSIZE, CF, M, $ WORK, LWORK, INFO) * * Compute |C*QT - C*QT| / |C| |