diff options
| -rw-r--r-- | SRC/ctprfb.f | 16 | ||||
| -rw-r--r-- | SRC/dtprfb.f | 16 | ||||
| -rw-r--r-- | SRC/stprfb.f | 16 | ||||
| -rw-r--r-- | SRC/ztprfb.f | 21 | ||||
| -rw-r--r-- | lapacke/include/lapacke.h | 112 | ||||
| -rw-r--r-- | lapacke/src/lapacke_ctpqrt.c | 10 | ||||
| -rw-r--r-- | lapacke/src/lapacke_ctpqrt2.c | 5 | ||||
| -rw-r--r-- | lapacke/src/lapacke_ctpqrt2_work.c | 7 | ||||
| -rw-r--r-- | lapacke/src/lapacke_ctpqrt_work.c | 8 | ||||
| -rw-r--r-- | lapacke/src/lapacke_ctprfb.c | 28 | ||||
| -rw-r--r-- | lapacke/src/lapacke_ctprfb_work.c | 8 | ||||
| -rw-r--r-- | lapacke/src/lapacke_dtpqrt2.c | 5 | ||||
| -rw-r--r-- | lapacke/src/lapacke_dtpqrt2_work.c | 7 | ||||
| -rw-r--r-- | lapacke/src/lapacke_dtprfb.c | 27 | ||||
| -rw-r--r-- | lapacke/src/lapacke_dtprfb_work.c | 8 | ||||
| -rw-r--r-- | lapacke/src/lapacke_stpqrt2.c | 5 | ||||
| -rw-r--r-- | lapacke/src/lapacke_stpqrt2_work.c | 7 | ||||
| -rw-r--r-- | lapacke/src/lapacke_stprfb.c | 27 | ||||
| -rw-r--r-- | lapacke/src/lapacke_stprfb_work.c | 10 | ||||
| -rw-r--r-- | lapacke/src/lapacke_ztpqrt2.c | 5 | ||||
| -rw-r--r-- | lapacke/src/lapacke_ztpqrt2_work.c | 7 | ||||
| -rw-r--r-- | lapacke/src/lapacke_ztprfb.c | 27 | ||||
| -rw-r--r-- | lapacke/src/lapacke_ztprfb_work.c | 8 |
23 files changed, 255 insertions, 135 deletions
diff --git a/SRC/ctprfb.f b/SRC/ctprfb.f index b3d23b55..3eacae09 100644 --- a/SRC/ctprfb.f +++ b/SRC/ctprfb.f @@ -273,7 +273,7 @@ * .. * .. Local Scalars .. INTEGER I, J, MP, NP, KP - LOGICAL LEFT, FORWARD, COLUMN, RIGHT, BACKWARD, ROW + LOGICAL LEFT, LQUERY, FORWARD, COLUMN, RIGHT, BACKWARD, ROW * .. * .. External Functions .. LOGICAL LSAME @@ -287,6 +287,7 @@ * .. * .. Executable Statements .. * + LQUERY = ( LDWORK.EQ.-1 ) * Quick return if possible * IF( M.LE.0 .OR. N.LE.0 .OR. K.LE.0 .OR. L.LT.0 ) RETURN @@ -323,6 +324,19 @@ FORWARD = .FALSE. BACKWARD = .FALSE. END IF +* --------------------------------------------------------------------------- +* +* Workspace Query +* + IF( LQUERY .AND. LEFT ) THEN + LDWORK=MAX(1,K) + ELSE IF ( LQUERY .AND. RIGHT ) THEN + LDWORK=MAX(1,M) + END IF + + IF( LQUERY ) THEN + RETURN + END IF * * --------------------------------------------------------------------------- * diff --git a/SRC/dtprfb.f b/SRC/dtprfb.f index 6b892176..9b0f4971 100644 --- a/SRC/dtprfb.f +++ b/SRC/dtprfb.f @@ -273,7 +273,7 @@ * .. * .. Local Scalars .. INTEGER I, J, MP, NP, KP - LOGICAL LEFT, FORWARD, COLUMN, RIGHT, BACKWARD, ROW + LOGICAL LEFT, LQUERY, FORWARD, COLUMN, RIGHT, BACKWARD, ROW * .. * .. External Functions .. LOGICAL LSAME @@ -284,6 +284,7 @@ * .. * .. Executable Statements .. * + LQUERY = ( LDWORK.EQ.-1 ) * Quick return if possible * IF( M.LE.0 .OR. N.LE.0 .OR. K.LE.0 .OR. L.LT.0 ) RETURN @@ -320,6 +321,19 @@ FORWARD = .FALSE. BACKWARD = .FALSE. END IF +* --------------------------------------------------------------------------- +* +* Workspace Query +* + IF( LQUERY .AND. LEFT ) THEN + LDWORK=MAX(1,K) + ELSE IF ( LQUERY .AND. RIGHT ) THEN + LDWORK=MAX(1,M) + END IF + + IF( LQUERY ) THEN + RETURN + END IF * * --------------------------------------------------------------------------- * diff --git a/SRC/stprfb.f b/SRC/stprfb.f index de9253e7..3a0b23f5 100644 --- a/SRC/stprfb.f +++ b/SRC/stprfb.f @@ -273,7 +273,7 @@ * .. * .. Local Scalars .. INTEGER I, J, MP, NP, KP - LOGICAL LEFT, FORWARD, COLUMN, RIGHT, BACKWARD, ROW + LOGICAL LEFT, LQUERY, FORWARD, COLUMN, RIGHT, BACKWARD, ROW * .. * .. External Functions .. LOGICAL LSAME @@ -284,6 +284,7 @@ * .. * .. Executable Statements .. * + LQUERY = ( LDWORK.EQ.-1 ) * Quick return if possible * IF( M.LE.0 .OR. N.LE.0 .OR. K.LE.0 .OR. L.LT.0 ) RETURN @@ -320,6 +321,19 @@ FORWARD = .FALSE. BACKWARD = .FALSE. END IF +* --------------------------------------------------------------------------- +* +* Workspace Query +* + IF( LQUERY .AND. LEFT ) THEN + LDWORK=MAX(1,K) + ELSE IF ( LQUERY .AND. RIGHT ) THEN + LDWORK=MAX(1,M) + END IF + + IF( LQUERY ) THEN + RETURN + END IF * * --------------------------------------------------------------------------- * diff --git a/SRC/ztprfb.f b/SRC/ztprfb.f index 9110f494..d3d84505 100644 --- a/SRC/ztprfb.f +++ b/SRC/ztprfb.f @@ -184,6 +184,11 @@ *> The leading dimension of the array WORK. *> If SIDE = 'L', LDWORK >= K; *> if SIDE = 'R', LDWORK >= M. +*> +*> If LDWORK = -1, then a workspace query is assumed; the routine +*> only calculates the optimal size of 2nd dimension of the WORK array, +*> returns this value as the first entry of the WORK array, and no +*> error message related to LDWORK is issued by XERBLA. *> \endverbatim * * Authors: @@ -273,7 +278,7 @@ * .. * .. Local Scalars .. INTEGER I, J, MP, NP, KP - LOGICAL LEFT, FORWARD, COLUMN, RIGHT, BACKWARD, ROW + LOGICAL LEFT, LQUERY, FORWARD, COLUMN, RIGHT, BACKWARD, ROW * .. * .. External Functions .. LOGICAL LSAME @@ -287,6 +292,7 @@ * .. * .. Executable Statements .. * + LQUERY = ( LDWORK.EQ.-1 ) * Quick return if possible * IF( M.LE.0 .OR. N.LE.0 .OR. K.LE.0 .OR. L.LT.0 ) RETURN @@ -323,6 +329,19 @@ FORWARD = .FALSE. BACKWARD = .FALSE. END IF +* --------------------------------------------------------------------------- +* +* Workspace Query +* + IF( LQUERY .AND. LEFT ) THEN + LDWORK=MAX(1,K) + ELSE IF ( LQUERY .AND. RIGHT ) THEN + LDWORK=MAX(1,M) + END IF + + IF( LQUERY ) THEN + RETURN + END IF * * --------------------------------------------------------------------------- * diff --git a/lapacke/include/lapacke.h b/lapacke/include/lapacke.h index efcddeeb..28663410 100644 --- a/lapacke/include/lapacke.h +++ b/lapacke/include/lapacke.h @@ -10396,27 +10396,33 @@ lapack_int LAPACKE_dtpqrt( int matrix_order, lapack_int m, lapack_int n, lapack_int lda, double* b, lapack_int ldb, double* t, lapack_int ldt ); lapack_int LAPACKE_ctpqrt( int matrix_order, lapack_int m, lapack_int n, - lapack_int l, lapack_int nb, lapack_complex_float* a, - lapack_int lda, lapack_complex_float* t, + lapack_int l, lapack_int nb, + lapack_complex_float* a, lapack_int lda, lapack_complex_float* b, lapack_int ldb, - lapack_int ldt ); + lapack_complex_float* t, lapack_int ldt ); lapack_int LAPACKE_ztpqrt( int matrix_order, lapack_int m, lapack_int n, lapack_int l, lapack_int nb, lapack_complex_double* a, lapack_int lda, lapack_complex_double* b, lapack_int ldb, lapack_complex_double* t, lapack_int ldt ); -lapack_int LAPACKE_stpqrt2( int matrix_order, lapack_int m, lapack_int n, - float* a, lapack_int lda, float* b, lapack_int ldb, +lapack_int LAPACKE_stpqrt2( int matrix_order, + lapack_int m, lapack_int n, lapack_int l, + float* a, lapack_int lda, + float* b, lapack_int ldb, float* t, lapack_int ldt ); -lapack_int LAPACKE_dtpqrt2( int matrix_order, lapack_int m, lapack_int n, - double* a, lapack_int lda, double* b, - lapack_int ldb, double* t, lapack_int ldt ); -lapack_int LAPACKE_ctpqrt2( int matrix_order, lapack_int m, lapack_int n, +lapack_int LAPACKE_dtpqrt2( int matrix_order, + lapack_int m, lapack_int n, lapack_int l, + double* a, lapack_int lda, + double* b, lapack_int ldb, + double* t, lapack_int ldt ); +lapack_int LAPACKE_ctpqrt2( int matrix_order, + lapack_int m, lapack_int n, lapack_int l, lapack_complex_float* a, lapack_int lda, lapack_complex_float* b, lapack_int ldb, lapack_complex_float* t, lapack_int ldt ); -lapack_int LAPACKE_ztpqrt2( int matrix_order, lapack_int m, lapack_int n, +lapack_int LAPACKE_ztpqrt2( int matrix_order, + lapack_int m, lapack_int n, lapack_int l, lapack_complex_double* a, lapack_int lda, lapack_complex_double* b, lapack_int ldb, lapack_complex_double* t, lapack_int ldt ); @@ -10425,30 +10431,26 @@ lapack_int LAPACKE_stprfb( int matrix_order, char side, char trans, char direct, char storev, lapack_int m, lapack_int n, lapack_int k, lapack_int l, const float* v, lapack_int ldv, const float* t, lapack_int ldt, - float* a, lapack_int lda, float* b, lapack_int ldb, - lapack_int myldwork ); + float* a, lapack_int lda, float* b, lapack_int ldb ); lapack_int LAPACKE_dtprfb( int matrix_order, char side, char trans, char direct, char storev, lapack_int m, lapack_int n, lapack_int k, lapack_int l, const double* v, lapack_int ldv, const double* t, lapack_int ldt, - double* a, lapack_int lda, double* b, lapack_int ldb, - lapack_int myldwork ); + double* a, lapack_int lda, double* b, lapack_int ldb ); lapack_int LAPACKE_ctprfb( int matrix_order, char side, char trans, char direct, char storev, lapack_int m, lapack_int n, lapack_int k, lapack_int l, const lapack_complex_float* v, lapack_int ldv, const lapack_complex_float* t, lapack_int ldt, lapack_complex_float* a, lapack_int lda, - lapack_complex_float* b, lapack_int ldb, - lapack_int myldwork ); + lapack_complex_float* b, lapack_int ldb ); lapack_int LAPACKE_ztprfb( int matrix_order, char side, char trans, char direct, char storev, lapack_int m, lapack_int n, lapack_int k, lapack_int l, const lapack_complex_double* v, lapack_int ldv, const lapack_complex_double* t, lapack_int ldt, lapack_complex_double* a, lapack_int lda, - lapack_complex_double* b, lapack_int ldb, - lapack_int myldwork ); + lapack_complex_double* b, lapack_int ldb ); lapack_int LAPACKE_sgemqrt_work( int matrix_order, char side, char trans, lapack_int m, lapack_int n, lapack_int k, @@ -10550,9 +10552,9 @@ lapack_int LAPACKE_dtpqrt_work( int matrix_order, lapack_int m, lapack_int n, lapack_int LAPACKE_ctpqrt_work( int matrix_order, lapack_int m, lapack_int n, lapack_int l, lapack_int nb, lapack_complex_float* a, lapack_int lda, - lapack_complex_float* t, lapack_complex_float* b, lapack_int ldb, - lapack_int ldt, lapack_complex_float* work ); + lapack_complex_float* t, lapack_int ldt, + lapack_complex_float* work ); lapack_int LAPACKE_ztpqrt_work( int matrix_order, lapack_int m, lapack_int n, lapack_int l, lapack_int nb, lapack_complex_double* a, lapack_int lda, @@ -10560,17 +10562,23 @@ lapack_int LAPACKE_ztpqrt_work( int matrix_order, lapack_int m, lapack_int n, lapack_complex_double* t, lapack_int ldt, lapack_complex_double* work ); -lapack_int LAPACKE_stpqrt2_work( int matrix_order, lapack_int m, lapack_int n, - float* a, lapack_int lda, float* b, - lapack_int ldb, float* t, lapack_int ldt ); -lapack_int LAPACKE_dtpqrt2_work( int matrix_order, lapack_int m, lapack_int n, - double* a, lapack_int lda, double* b, - lapack_int ldb, double* t, lapack_int ldt ); -lapack_int LAPACKE_ctpqrt2_work( int matrix_order, lapack_int m, lapack_int n, +lapack_int LAPACKE_stpqrt2_work( int matrix_order, + lapack_int m, lapack_int n, lapack_int l, + float* a, lapack_int lda, + float* b, lapack_int ldb, + float* t, lapack_int ldt ); +lapack_int LAPACKE_dtpqrt2_work( int matrix_order, + lapack_int m, lapack_int n, lapack_int l, + double* a, lapack_int lda, + double* b, lapack_int ldb, + double* t, lapack_int ldt ); +lapack_int LAPACKE_ctpqrt2_work( int matrix_order, + lapack_int m, lapack_int n, lapack_int l, lapack_complex_float* a, lapack_int lda, lapack_complex_float* b, lapack_int ldb, lapack_complex_float* t, lapack_int ldt ); -lapack_int LAPACKE_ztpqrt2_work( int matrix_order, lapack_int m, lapack_int n, +lapack_int LAPACKE_ztpqrt2_work( int matrix_order, + lapack_int m, lapack_int n, lapack_int l, lapack_complex_double* a, lapack_int lda, lapack_complex_double* b, lapack_int ldb, lapack_complex_double* t, lapack_int ldt ); @@ -10580,15 +10588,15 @@ lapack_int LAPACKE_stprfb_work( int matrix_order, char side, char trans, lapack_int n, lapack_int k, lapack_int l, const float* v, lapack_int ldv, const float* t, lapack_int ldt, float* a, lapack_int lda, - float* b, lapack_int ldb, const float* mywork, - lapack_int myldwork ); + float* b, lapack_int ldb, const float* work, + lapack_int ldwork ); lapack_int LAPACKE_dtprfb_work( int matrix_order, char side, char trans, char direct, char storev, lapack_int m, lapack_int n, lapack_int k, lapack_int l, const double* v, lapack_int ldv, const double* t, lapack_int ldt, double* a, lapack_int lda, double* b, lapack_int ldb, - const double* mywork, lapack_int myldwork ); + const double* work, lapack_int ldwork ); lapack_int LAPACKE_ctprfb_work( int matrix_order, char side, char trans, char direct, char storev, lapack_int m, lapack_int n, lapack_int k, lapack_int l, @@ -10596,7 +10604,7 @@ lapack_int LAPACKE_ctprfb_work( int matrix_order, char side, char trans, const lapack_complex_float* t, lapack_int ldt, lapack_complex_float* a, lapack_int lda, lapack_complex_float* b, lapack_int ldb, - const float* mywork, lapack_int myldwork ); + const float* work, lapack_int ldwork ); lapack_int LAPACKE_ztprfb_work( int matrix_order, char side, char trans, char direct, char storev, lapack_int m, lapack_int n, lapack_int k, lapack_int l, @@ -10604,7 +10612,7 @@ lapack_int LAPACKE_ztprfb_work( int matrix_order, char side, char trans, const lapack_complex_double* t, lapack_int ldt, lapack_complex_double* a, lapack_int lda, lapack_complex_double* b, lapack_int ldb, - const double* mywork, lapack_int myldwork ); + const double* work, lapack_int ldwork ); //LAPACK 3.X.X lapack_int LAPACKE_ssysv_rook( int matrix_order, char uplo, lapack_int n, lapack_int nrhs, float* a, lapack_int lda, @@ -16285,54 +16293,60 @@ void LAPACK_dtpqrt( lapack_int* m, lapack_int* n, lapack_int* l, lapack_int* nb, lapack_int *info ); void LAPACK_ctpqrt( lapack_int* m, lapack_int* n, lapack_int* l, lapack_int* nb, lapack_complex_float* a, lapack_int* lda, - lapack_complex_float* t, lapack_complex_float* b, - lapack_int* ldb, lapack_int* ldt, + lapack_complex_float* b, lapack_int* ldb, + lapack_complex_float* t, lapack_int* ldt, lapack_complex_float* work, lapack_int *info ); void LAPACK_ztpqrt( lapack_int* m, lapack_int* n, lapack_int* l, lapack_int* nb, lapack_complex_double* a, lapack_int* lda, lapack_complex_double* b, lapack_int* ldb, lapack_complex_double* t, lapack_int* ldt, lapack_complex_double* work, lapack_int *info ); -void LAPACK_stpqrt2( lapack_int* m, lapack_int* n, float* a, lapack_int* lda, - float* b, lapack_int* ldb, float* t, lapack_int* ldt, +void LAPACK_stpqrt2( lapack_int* m, lapack_int* n, lapack_int* l, + float* a, lapack_int* lda, + float* b, lapack_int* ldb, + float* t, lapack_int* ldt, lapack_int *info ); -void LAPACK_dtpqrt2( lapack_int* m, lapack_int* n, double* a, lapack_int* lda, - double* b, lapack_int* ldb, double* t, lapack_int* ldt, +void LAPACK_dtpqrt2( lapack_int* m, lapack_int* n, lapack_int* l, + double* a, lapack_int* lda, + double* b, lapack_int* ldb, + double* t, lapack_int* ldt, lapack_int *info ); -void LAPACK_ctpqrt2( lapack_int* m, lapack_int* n, lapack_complex_float* a, - lapack_int* lda, lapack_complex_float* b, lapack_int* ldb, +void LAPACK_ctpqrt2( lapack_int* m, lapack_int* n, lapack_int* l, + lapack_complex_float* a, lapack_int* lda, + lapack_complex_float* b, lapack_int* ldb, lapack_complex_float* t, lapack_int* ldt, lapack_int *info ); -void LAPACK_ztpqrt2( lapack_int* m, lapack_int* n, lapack_complex_double* a, - lapack_int* lda, lapack_complex_double* b, lapack_int* ldb, +void LAPACK_ztpqrt2( lapack_int* m, lapack_int* n, lapack_int* l, + lapack_complex_double* a, lapack_int* lda, + lapack_complex_double* b, lapack_int* ldb, lapack_complex_double* t, lapack_int* ldt, lapack_int *info ); void LAPACK_stprfb( char* side, char* trans, char* direct, char* storev, lapack_int* m, lapack_int* n, lapack_int* k, lapack_int* l, const float* v, lapack_int* ldv, const float* t, lapack_int* ldt, float* a, lapack_int* lda, float* b, - lapack_int* ldb, const float* mywork, - lapack_int* myldwork ); + lapack_int* ldb, const float* work, + lapack_int* ldwork ); void LAPACK_dtprfb( char* side, char* trans, char* direct, char* storev, lapack_int* m, lapack_int* n, lapack_int* k, lapack_int* l, const double* v, lapack_int* ldv, const double* t, lapack_int* ldt, double* a, lapack_int* lda, double* b, - lapack_int* ldb, const double* mywork, - lapack_int* myldwork ); + lapack_int* ldb, const double* work, + lapack_int* ldwork ); void LAPACK_ctprfb( char* side, char* trans, char* direct, char* storev, lapack_int* m, lapack_int* n, lapack_int* k, lapack_int* l, const lapack_complex_float* v, lapack_int* ldv, const lapack_complex_float* t, lapack_int* ldt, lapack_complex_float* a, lapack_int* lda, lapack_complex_float* b, lapack_int* ldb, - const float* mywork, lapack_int* myldwork ); + const float* work, lapack_int* ldwork ); void LAPACK_ztprfb( char* side, char* trans, char* direct, char* storev, lapack_int* m, lapack_int* n, lapack_int* k, lapack_int* l, const lapack_complex_double* v, lapack_int* ldv, const lapack_complex_double* t, lapack_int* ldt, lapack_complex_double* a, lapack_int* lda, lapack_complex_double* b, lapack_int* ldb, - const double* mywork, lapack_int* myldwork ); + const double* work, lapack_int* ldwork ); // LAPACK 3.5.0 void LAPACK_ssysv_rook( char* uplo, lapack_int* n, lapack_int* nrhs, float* a, lapack_int* lda, lapack_int* ipiv, float* b, diff --git a/lapacke/src/lapacke_ctpqrt.c b/lapacke/src/lapacke_ctpqrt.c index f143271f..db5a87be 100644 --- a/lapacke/src/lapacke_ctpqrt.c +++ b/lapacke/src/lapacke_ctpqrt.c @@ -34,10 +34,10 @@ #include "lapacke_utils.h" lapack_int LAPACKE_ctpqrt( int matrix_order, lapack_int m, lapack_int n, - lapack_int l, lapack_int nb, lapack_complex_float* a, - lapack_int lda, lapack_complex_float* t, + lapack_int l, lapack_int nb, + lapack_complex_float* a, lapack_int lda, lapack_complex_float* b, lapack_int ldb, - lapack_int ldt ) + lapack_complex_float* t, lapack_int ldt ) { lapack_int info = 0; lapack_complex_float* work = NULL; @@ -62,8 +62,8 @@ lapack_int LAPACKE_ctpqrt( int matrix_order, lapack_int m, lapack_int n, goto exit_level_0; } /* Call middle-level interface */ - info = LAPACKE_ctpqrt_work( matrix_order, m, n, l, nb, a, lda, t, b, ldb, - ldt, work ); + info = LAPACKE_ctpqrt_work( matrix_order, m, n, l, nb, a, lda, b, ldb, + t, ldt, work ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: diff --git a/lapacke/src/lapacke_ctpqrt2.c b/lapacke/src/lapacke_ctpqrt2.c index 88e25a6a..607ebf46 100644 --- a/lapacke/src/lapacke_ctpqrt2.c +++ b/lapacke/src/lapacke_ctpqrt2.c @@ -33,7 +33,8 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ctpqrt2( int matrix_order, lapack_int m, lapack_int n, +lapack_int LAPACKE_ctpqrt2( int matrix_order, + lapack_int m, lapack_int n, lapack_int l, lapack_complex_float* a, lapack_int lda, lapack_complex_float* b, lapack_int ldb, lapack_complex_float* t, lapack_int ldt ) @@ -51,5 +52,5 @@ lapack_int LAPACKE_ctpqrt2( int matrix_order, lapack_int m, lapack_int n, return -6; } #endif - return LAPACKE_ctpqrt2_work( matrix_order, m, n, a, lda, b, ldb, t, ldt ); + return LAPACKE_ctpqrt2_work( matrix_order, m, n, l, a, lda, b, ldb, t, ldt ); } diff --git a/lapacke/src/lapacke_ctpqrt2_work.c b/lapacke/src/lapacke_ctpqrt2_work.c index d11290bc..7ea0801e 100644 --- a/lapacke/src/lapacke_ctpqrt2_work.c +++ b/lapacke/src/lapacke_ctpqrt2_work.c @@ -33,7 +33,8 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ctpqrt2_work( int matrix_order, lapack_int m, lapack_int n, +lapack_int LAPACKE_ctpqrt2_work( int matrix_order, + lapack_int m, lapack_int n, lapack_int l, lapack_complex_float* a, lapack_int lda, lapack_complex_float* b, lapack_int ldb, lapack_complex_float* t, lapack_int ldt ) @@ -41,7 +42,7 @@ lapack_int LAPACKE_ctpqrt2_work( int matrix_order, lapack_int m, lapack_int n, lapack_int info = 0; if( matrix_order == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ - LAPACK_ctpqrt2( &m, &n, a, &lda, b, &ldb, t, &ldt, &info ); + LAPACK_ctpqrt2( &m, &n, &l, a, &lda, b, &ldb, t, &ldt, &info ); if( info < 0 ) { info = info - 1; } @@ -91,7 +92,7 @@ lapack_int LAPACKE_ctpqrt2_work( int matrix_order, lapack_int m, lapack_int n, LAPACKE_cge_trans( matrix_order, n, n, a, lda, a_t, lda_t ); LAPACKE_cge_trans( matrix_order, m, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ - LAPACK_ctpqrt2( &m, &n, a_t, &lda_t, b_t, &ldb_t, t_t, &ldt_t, &info ); + LAPACK_ctpqrt2( &m, &n, &l, a_t, &lda_t, b_t, &ldb_t, t_t, &ldt_t, &info ); if( info < 0 ) { info = info - 1; } diff --git a/lapacke/src/lapacke_ctpqrt_work.c b/lapacke/src/lapacke_ctpqrt_work.c index cbb105c6..d5c3e617 100644 --- a/lapacke/src/lapacke_ctpqrt_work.c +++ b/lapacke/src/lapacke_ctpqrt_work.c @@ -36,14 +36,14 @@ lapack_int LAPACKE_ctpqrt_work( int matrix_order, lapack_int m, lapack_int n, lapack_int l, lapack_int nb, lapack_complex_float* a, lapack_int lda, - lapack_complex_float* t, lapack_complex_float* b, lapack_int ldb, - lapack_int ldt, lapack_complex_float* work ) + lapack_complex_float* t, lapack_int ldt, + lapack_complex_float* work ) { lapack_int info = 0; if( matrix_order == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ - LAPACK_ctpqrt( &m, &n, &l, &nb, a, &lda, t, b, &ldb, &ldt, work, + LAPACK_ctpqrt( &m, &n, &l, &nb, a, &lda, b, &ldb, t, &ldt, work, &info ); if( info < 0 ) { info = info - 1; @@ -94,7 +94,7 @@ lapack_int LAPACKE_ctpqrt_work( int matrix_order, lapack_int m, lapack_int n, LAPACKE_cge_trans( matrix_order, n, n, a, lda, a_t, lda_t ); LAPACKE_cge_trans( matrix_order, m, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ - LAPACK_ctpqrt( &m, &n, &l, &nb, a_t, &lda_t, t_t, b_t, &ldb_t, &ldt_t, + LAPACK_ctpqrt( &m, &n, &l, &nb, a_t, &lda_t, b_t, &ldb_t, t_t, &ldt_t, work, &info ); if( info < 0 ) { info = info - 1; diff --git a/lapacke/src/lapacke_ctprfb.c b/lapacke/src/lapacke_ctprfb.c index 09357a2f..8c5da9f1 100644 --- a/lapacke/src/lapacke_ctprfb.c +++ b/lapacke/src/lapacke_ctprfb.c @@ -39,11 +39,12 @@ lapack_int LAPACKE_ctprfb( int matrix_order, char side, char trans, char direct, const lapack_complex_float* v, lapack_int ldv, const lapack_complex_float* t, lapack_int ldt, lapack_complex_float* a, lapack_int lda, - lapack_complex_float* b, lapack_int ldb, - lapack_int myldwork ) + lapack_complex_float* b, lapack_int ldb ) { lapack_int info = 0; - float* mywork = NULL; + lapack_int ldwork = -1; + float* work = NULL; + float work_query; if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) { LAPACKE_xerbla( "LAPACKE_ctprfb", -1 ); return -1; @@ -64,18 +65,27 @@ lapack_int LAPACKE_ctprfb( int matrix_order, char side, char trans, char direct, } #endif /* Allocate memory for working array(s) */ - mywork = (float*) - LAPACKE_malloc( sizeof(float) * MAX(1,myldwork) * MAX(1,k) ); - if( mywork == NULL ) { + /* Query optimal working array(s) size */ + info = LAPACKE_ctprfb_work( matrix_order, side, trans, direct, storev, m, n, + k, l, v, ldv, t, ldt, a, lda, b, ldb, + &work_query, ldwork ); + if( info != 0 ) { + goto exit_level_0; + } + ldwork = (lapack_int)work_query; + /* Allocate memory for working array(s) */ + work = (float*) + LAPACKE_malloc( sizeof(float) * MAX(1,ldwork) * MAX(n,k) ); + if( work == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; goto exit_level_0; } /* Call middle-level interface */ info = LAPACKE_ctprfb_work( matrix_order, side, trans, direct, storev, m, n, - k, l, v, ldv, t, ldt, a, lda, b, ldb, mywork, - myldwork ); + k, l, v, ldv, t, ldt, a, lda, b, ldb, work, + ldwork ); /* Release memory and exit */ - LAPACKE_free( mywork ); + LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { LAPACKE_xerbla( "LAPACKE_ctprfb", info ); diff --git a/lapacke/src/lapacke_ctprfb_work.c b/lapacke/src/lapacke_ctprfb_work.c index ef7d8767..a78c5e2a 100644 --- a/lapacke/src/lapacke_ctprfb_work.c +++ b/lapacke/src/lapacke_ctprfb_work.c @@ -40,13 +40,13 @@ lapack_int LAPACKE_ctprfb_work( int matrix_order, char side, char trans, const lapack_complex_float* t, lapack_int ldt, lapack_complex_float* a, lapack_int lda, lapack_complex_float* b, lapack_int ldb, - const float* mywork, lapack_int myldwork ) + const float* work, lapack_int ldwork ) { lapack_int info = 0; if( matrix_order == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ LAPACK_ctprfb( &side, &trans, &direct, &storev, &m, &n, &k, &l, v, &ldv, - t, &ldt, a, &lda, b, &ldb, mywork, &myldwork ); + t, &ldt, a, &lda, b, &ldb, work, &ldwork ); if( info < 0 ) { info = info - 1; } @@ -113,8 +113,8 @@ lapack_int LAPACKE_ctprfb_work( int matrix_order, char side, char trans, LAPACKE_cge_trans( matrix_order, m, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_ctprfb( &side, &trans, &direct, &storev, &m, &n, &k, &l, v_t, - &ldv_t, t_t, &ldt_t, a_t, &lda_t, b_t, &ldb_t, mywork, - &myldwork ); + &ldv_t, t_t, &ldt_t, a_t, &lda_t, b_t, &ldb_t, work, + &ldwork ); info = 0; /* LAPACK call is ok! */ /* Transpose output matrices */ LAPACKE_cge_trans( LAPACK_COL_MAJOR, k, m, a_t, lda_t, a, lda ); diff --git a/lapacke/src/lapacke_dtpqrt2.c b/lapacke/src/lapacke_dtpqrt2.c index 5c1b02cf..19637370 100644 --- a/lapacke/src/lapacke_dtpqrt2.c +++ b/lapacke/src/lapacke_dtpqrt2.c @@ -33,7 +33,8 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dtpqrt2( int matrix_order, lapack_int m, lapack_int n, +lapack_int LAPACKE_dtpqrt2( int matrix_order, + lapack_int m, lapack_int n, lapack_int l, double* a, lapack_int lda, double* b, lapack_int ldb, double* t, lapack_int ldt ) { @@ -50,5 +51,5 @@ lapack_int LAPACKE_dtpqrt2( int matrix_order, lapack_int m, lapack_int n, return -6; } #endif - return LAPACKE_dtpqrt2_work( matrix_order, m, n, a, lda, b, ldb, t, ldt ); + return LAPACKE_dtpqrt2_work( matrix_order, m, n, l, a, lda, b, ldb, t, ldt ); } diff --git a/lapacke/src/lapacke_dtpqrt2_work.c b/lapacke/src/lapacke_dtpqrt2_work.c index 4f7e15f8..558f73ab 100644 --- a/lapacke/src/lapacke_dtpqrt2_work.c +++ b/lapacke/src/lapacke_dtpqrt2_work.c @@ -33,14 +33,15 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_dtpqrt2_work( int matrix_order, lapack_int m, lapack_int n, +lapack_int LAPACKE_dtpqrt2_work( int matrix_order, + lapack_int m, lapack_int n, lapack_int l, double* a, lapack_int lda, double* b, lapack_int ldb, double* t, lapack_int ldt ) { lapack_int info = 0; if( matrix_order == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ - LAPACK_dtpqrt2( &m, &n, a, &lda, b, &ldb, t, &ldt, &info ); + LAPACK_dtpqrt2( &m, &n, &l, a, &lda, b, &ldb, t, &ldt, &info ); if( info < 0 ) { info = info - 1; } @@ -87,7 +88,7 @@ lapack_int LAPACKE_dtpqrt2_work( int matrix_order, lapack_int m, lapack_int n, LAPACKE_dge_trans( matrix_order, n, n, a, lda, a_t, lda_t ); LAPACKE_dge_trans( matrix_order, m, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ - LAPACK_dtpqrt2( &m, &n, a_t, &lda_t, b_t, &ldb_t, t_t, &ldt_t, &info ); + LAPACK_dtpqrt2( &m, &n, &l, a_t, &lda_t, b_t, &ldb_t, t_t, &ldt_t, &info ); if( info < 0 ) { info = info - 1; } diff --git a/lapacke/src/lapacke_dtprfb.c b/lapacke/src/lapacke_dtprfb.c index 9728ca72..1a51bc3c 100644 --- a/lapacke/src/lapacke_dtprfb.c +++ b/lapacke/src/lapacke_dtprfb.c @@ -37,11 +37,12 @@ lapack_int LAPACKE_dtprfb( int matrix_order, char side, char trans, char direct, char storev, lapack_int m, lapack_int n, lapack_int k, lapack_int l, const double* v, lapack_int ldv, const double* t, lapack_int ldt, - double* a, lapack_int lda, double* b, lapack_int ldb, - lapack_int myldwork ) + double* a, lapack_int lda, double* b, lapack_int ldb ) { lapack_int info = 0; - double* mywork = NULL; + lapack_int ldwork = -1; + double* work = NULL; + double work_query; if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) { LAPACKE_xerbla( "LAPACKE_dtprfb", -1 ); return -1; @@ -61,19 +62,27 @@ lapack_int LAPACKE_dtprfb( int matrix_order, char side, char trans, char direct, return -10; } #endif + /* Query optimal working array(s) size */ + info = LAPACKE_dtprfb_work( matrix_order, side, trans, direct, storev, m, n, + k, l, v, ldv, t, ldt, a, lda, b, ldb, + &work_query, ldwork ); + if( info != 0 ) { + goto exit_level_0; + } + ldwork = (lapack_int)work_query; /* Allocate memory for working array(s) */ - mywork = (double*) - LAPACKE_malloc( sizeof(double) * MAX(1,myldwork) * MAX(1,k) ); - if( mywork == NULL ) { + work = (double*) + LAPACKE_malloc( sizeof(double) * MAX(1,ldwork) * MAX(n,k) ); + if( work == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; goto exit_level_0; } /* Call middle-level interface */ info = LAPACKE_dtprfb_work( matrix_order, side, trans, direct, storev, m, n, - k, l, v, ldv, t, ldt, a, lda, b, ldb, mywork, - myldwork ); + k, l, v, ldv, t, ldt, a, lda, b, ldb, work, + ldwork ); /* Release memory and exit */ - LAPACKE_free( mywork ); + LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { LAPACKE_xerbla( "LAPACKE_dtprfb", info ); diff --git a/lapacke/src/lapacke_dtprfb_work.c b/lapacke/src/lapacke_dtprfb_work.c index afe3f017..07fb69e4 100644 --- a/lapacke/src/lapacke_dtprfb_work.c +++ b/lapacke/src/lapacke_dtprfb_work.c @@ -39,13 +39,13 @@ lapack_int LAPACKE_dtprfb_work( int matrix_order, char side, char trans, const double* v, lapack_int ldv, const double* t, lapack_int ldt, double* a, lapack_int lda, double* b, lapack_int ldb, - const double* mywork, lapack_int myldwork ) + const double* work, lapack_int ldwork ) { lapack_int info = 0; if( matrix_order == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ LAPACK_dtprfb( &side, &trans, &direct, &storev, &m, &n, &k, &l, v, &ldv, - t, &ldt, a, &lda, b, &ldb, mywork, &myldwork ); + t, &ldt, a, &lda, b, &ldb, work, &ldwork ); if( info < 0 ) { info = info - 1; } @@ -108,8 +108,8 @@ lapack_int LAPACKE_dtprfb_work( int matrix_order, char side, char trans, LAPACKE_dge_trans( matrix_order, m, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_dtprfb( &side, &trans, &direct, &storev, &m, &n, &k, &l, v_t, - &ldv_t, t_t, &ldt_t, a_t, &lda_t, b_t, &ldb_t, mywork, - &myldwork ); + &ldv_t, t_t, &ldt_t, a_t, &lda_t, b_t, &ldb_t, work, + &ldwork ); info = 0; /* LAPACK call is ok! */ /* Transpose output matrices */ LAPACKE_dge_trans( LAPACK_COL_MAJOR, k, m, a_t, lda_t, a, lda ); diff --git a/lapacke/src/lapacke_stpqrt2.c b/lapacke/src/lapacke_stpqrt2.c index ddd5d81e..81a5f9c0 100644 --- a/lapacke/src/lapacke_stpqrt2.c +++ b/lapacke/src/lapacke_stpqrt2.c @@ -33,7 +33,8 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_stpqrt2( int matrix_order, lapack_int m, lapack_int n, +lapack_int LAPACKE_stpqrt2( int matrix_order, + lapack_int m, lapack_int n, lapack_int l, float* a, lapack_int lda, float* b, lapack_int ldb, float* t, lapack_int ldt ) { @@ -50,5 +51,5 @@ lapack_int LAPACKE_stpqrt2( int matrix_order, lapack_int m, lapack_int n, return -6; } #endif - return LAPACKE_stpqrt2_work( matrix_order, m, n, a, lda, b, ldb, t, ldt ); + return LAPACKE_stpqrt2_work( matrix_order, m, n, l, a, lda, b, ldb, t, ldt ); } diff --git a/lapacke/src/lapacke_stpqrt2_work.c b/lapacke/src/lapacke_stpqrt2_work.c index 1c850f9d..f4ac18c0 100644 --- a/lapacke/src/lapacke_stpqrt2_work.c +++ b/lapacke/src/lapacke_stpqrt2_work.c @@ -33,14 +33,15 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_stpqrt2_work( int matrix_order, lapack_int m, lapack_int n, +lapack_int LAPACKE_stpqrt2_work( int matrix_order, + lapack_int m, lapack_int n, lapack_int l, float* a, lapack_int lda, float* b, lapack_int ldb, float* t, lapack_int ldt ) { lapack_int info = 0; if( matrix_order == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ - LAPACK_stpqrt2( &m, &n, a, &lda, b, &ldb, t, &ldt, &info ); + LAPACK_stpqrt2( &m, &n, &l, a, &lda, b, &ldb, t, &ldt, &info ); if( info < 0 ) { info = info - 1; } @@ -87,7 +88,7 @@ lapack_int LAPACKE_stpqrt2_work( int matrix_order, lapack_int m, lapack_int n, LAPACKE_sge_trans( matrix_order, n, n, a, lda, a_t, lda_t ); LAPACKE_sge_trans( matrix_order, m, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ - LAPACK_stpqrt2( &m, &n, a_t, &lda_t, b_t, &ldb_t, t_t, &ldt_t, &info ); + LAPACK_stpqrt2( &m, &n, &l, a_t, &lda_t, b_t, &ldb_t, t_t, &ldt_t, &info ); if( info < 0 ) { info = info - 1; } diff --git a/lapacke/src/lapacke_stprfb.c b/lapacke/src/lapacke_stprfb.c index 83e451f1..e1bcd317 100644 --- a/lapacke/src/lapacke_stprfb.c +++ b/lapacke/src/lapacke_stprfb.c @@ -37,11 +37,12 @@ lapack_int LAPACKE_stprfb( int matrix_order, char side, char trans, char direct, char storev, lapack_int m, lapack_int n, lapack_int k, lapack_int l, const float* v, lapack_int ldv, const float* t, lapack_int ldt, - float* a, lapack_int lda, float* b, lapack_int ldb, - lapack_int myldwork ) + float* a, lapack_int lda, float* b, lapack_int ldb) { lapack_int info = 0; - float* mywork = NULL; + lapack_int ldwork = -1; + float* work = NULL; + float work_query; if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) { LAPACKE_xerbla( "LAPACKE_stprfb", -1 ); return -1; @@ -61,19 +62,27 @@ lapack_int LAPACKE_stprfb( int matrix_order, char side, char trans, char direct, return -10; } #endif + /* Query optimal working array(s) size */ + info = LAPACKE_stprfb_work( matrix_order, side, trans, direct, storev, m, n, + k, l, v, ldv, t, ldt, a, lda, b, ldb, + &work_query, ldwork ); + if( info != 0 ) { + goto exit_level_0; + } + ldwork = (lapack_int)work_query; /* Allocate memory for working array(s) */ - mywork = (float*) - LAPACKE_malloc( sizeof(float) * MAX(1,myldwork) * MAX(1,k) ); - if( mywork == NULL ) { + work = (float*) + LAPACKE_malloc( sizeof(float) * MAX(1,ldwork) * MAX(n,k) ); + if( work == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; goto exit_level_0; } /* Call middle-level interface */ info = LAPACKE_stprfb_work( matrix_order, side, trans, direct, storev, m, n, - k, l, v, ldv, t, ldt, a, lda, b, ldb, mywork, - myldwork ); + k, l, v, ldv, t, ldt, a, lda, b, ldb, work, + ldwork ); /* Release memory and exit */ - LAPACKE_free( mywork ); + LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { LAPACKE_xerbla( "LAPACKE_stprfb", info ); diff --git a/lapacke/src/lapacke_stprfb_work.c b/lapacke/src/lapacke_stprfb_work.c index 8407627d..11b002b9 100644 --- a/lapacke/src/lapacke_stprfb_work.c +++ b/lapacke/src/lapacke_stprfb_work.c @@ -38,14 +38,14 @@ lapack_int LAPACKE_stprfb_work( int matrix_order, char side, char trans, lapack_int n, lapack_int k, lapack_int l, const float* v, lapack_int ldv, const float* t, lapack_int ldt, float* a, lapack_int lda, - float* b, lapack_int ldb, const float* mywork, - lapack_int myldwork ) + float* b, lapack_int ldb, const float* work, + lapack_int ldwork ) { lapack_int info = 0; if( matrix_order == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ LAPACK_stprfb( &side, &trans, &direct, &storev, &m, &n, &k, &l, v, &ldv, - t, &ldt, a, &lda, b, &ldb, mywork, &myldwork ); + t, &ldt, a, &lda, b, &ldb, work, &ldwork ); if( info < 0 ) { info = info - 1; } @@ -108,8 +108,8 @@ lapack_int LAPACKE_stprfb_work( int matrix_order, char side, char trans, LAPACKE_sge_trans( matrix_order, m, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_stprfb( &side, &trans, &direct, &storev, &m, &n, &k, &l, v_t, - &ldv_t, t_t, &ldt_t, a_t, &lda_t, b_t, &ldb_t, mywork, - &myldwork ); + &ldv_t, t_t, &ldt_t, a_t, &lda_t, b_t, &ldb_t, work, + &ldwork ); info = 0; /* LAPACK call is ok! */ /* Transpose output matrices */ LAPACKE_sge_trans( LAPACK_COL_MAJOR, k, m, a_t, lda_t, a, lda ); diff --git a/lapacke/src/lapacke_ztpqrt2.c b/lapacke/src/lapacke_ztpqrt2.c index 1c707014..49ad429d 100644 --- a/lapacke/src/lapacke_ztpqrt2.c +++ b/lapacke/src/lapacke_ztpqrt2.c @@ -33,7 +33,8 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ztpqrt2( int matrix_order, lapack_int m, lapack_int n, +lapack_int LAPACKE_ztpqrt2( int matrix_order, + lapack_int m, lapack_int n, lapack_int l, lapack_complex_double* a, lapack_int lda, lapack_complex_double* b, lapack_int ldb, lapack_complex_double* t, lapack_int ldt ) @@ -51,5 +52,5 @@ lapack_int LAPACKE_ztpqrt2( int matrix_order, lapack_int m, lapack_int n, return -6; } #endif - return LAPACKE_ztpqrt2_work( matrix_order, m, n, a, lda, b, ldb, t, ldt ); + return LAPACKE_ztpqrt2_work( matrix_order, m, n, l, a, lda, b, ldb, t, ldt ); } diff --git a/lapacke/src/lapacke_ztpqrt2_work.c b/lapacke/src/lapacke_ztpqrt2_work.c index 1ac7cd4e..f9bfacfc 100644 --- a/lapacke/src/lapacke_ztpqrt2_work.c +++ b/lapacke/src/lapacke_ztpqrt2_work.c @@ -33,7 +33,8 @@ #include "lapacke_utils.h" -lapack_int LAPACKE_ztpqrt2_work( int matrix_order, lapack_int m, lapack_int n, +lapack_int LAPACKE_ztpqrt2_work( int matrix_order, + lapack_int m, lapack_int n, lapack_int l, lapack_complex_double* a, lapack_int lda, lapack_complex_double* b, lapack_int ldb, lapack_complex_double* t, lapack_int ldt ) @@ -41,7 +42,7 @@ lapack_int LAPACKE_ztpqrt2_work( int matrix_order, lapack_int m, lapack_int n, lapack_int info = 0; if( matrix_order == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ - LAPACK_ztpqrt2( &m, &n, a, &lda, b, &ldb, t, &ldt, &info ); + LAPACK_ztpqrt2( &m, &n, &l, a, &lda, b, &ldb, t, &ldt, &info ); if( info < 0 ) { info = info - 1; } @@ -91,7 +92,7 @@ lapack_int LAPACKE_ztpqrt2_work( int matrix_order, lapack_int m, lapack_int n, LAPACKE_zge_trans( matrix_order, n, n, a, lda, a_t, lda_t ); LAPACKE_zge_trans( matrix_order, m, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ - LAPACK_ztpqrt2( &m, &n, a_t, &lda_t, b_t, &ldb_t, t_t, &ldt_t, &info ); + LAPACK_ztpqrt2( &m, &n, &l, a_t, &lda_t, b_t, &ldb_t, t_t, &ldt_t, &info ); if( info < 0 ) { info = info - 1; } diff --git a/lapacke/src/lapacke_ztprfb.c b/lapacke/src/lapacke_ztprfb.c index 45eebb75..a1a6e4b2 100644 --- a/lapacke/src/lapacke_ztprfb.c +++ b/lapacke/src/lapacke_ztprfb.c @@ -39,11 +39,12 @@ lapack_int LAPACKE_ztprfb( int matrix_order, char side, char trans, char direct, const lapack_complex_double* v, lapack_int ldv, const lapack_complex_double* t, lapack_int ldt, lapack_complex_double* a, lapack_int lda, - lapack_complex_double* b, lapack_int ldb, - lapack_int myldwork ) + lapack_complex_double* b, lapack_int ldb) { lapack_int info = 0; - double* mywork = NULL; + lapack_int ldwork = -1; + double* work = NULL; + double work_query; if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) { LAPACKE_xerbla( "LAPACKE_ztprfb", -1 ); return -1; @@ -63,19 +64,27 @@ lapack_int LAPACKE_ztprfb( int matrix_order, char side, char trans, char direct, return -10; } #endif + /* Query optimal working array(s) size */ + info = LAPACKE_ztprfb_work( matrix_order, side, trans, direct, storev, m, n, + k, l, v, ldv, t, ldt, a, lda, b, ldb, + &work_query, ldwork ); + if( info != 0 ) { + goto exit_level_0; + } + ldwork = (lapack_int)work_query; /* Allocate memory for working array(s) */ - mywork = (double*) - LAPACKE_malloc( sizeof(double) * MAX(1,myldwork) * MAX(1,k) ); - if( mywork == NULL ) { + work = (double*) + LAPACKE_malloc( sizeof(double) * MAX(1,ldwork) * MAX(n,k) ); + if( work == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; goto exit_level_0; } /* Call middle-level interface */ info = LAPACKE_ztprfb_work( matrix_order, side, trans, direct, storev, m, n, - k, l, v, ldv, t, ldt, a, lda, b, ldb, mywork, - myldwork ); + k, l, v, ldv, t, ldt, a, lda, b, ldb, work, + ldwork ); /* Release memory and exit */ - LAPACKE_free( mywork ); + LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { LAPACKE_xerbla( "LAPACKE_ztprfb", info ); diff --git a/lapacke/src/lapacke_ztprfb_work.c b/lapacke/src/lapacke_ztprfb_work.c index 2ef7ec2d..ba4cc24e 100644 --- a/lapacke/src/lapacke_ztprfb_work.c +++ b/lapacke/src/lapacke_ztprfb_work.c @@ -40,13 +40,13 @@ lapack_int LAPACKE_ztprfb_work( int matrix_order, char side, char trans, const lapack_complex_double* t, lapack_int ldt, lapack_complex_double* a, lapack_int lda, lapack_complex_double* b, lapack_int ldb, - const double* mywork, lapack_int myldwork ) + const double* work, lapack_int ldwork ) { lapack_int info = 0; if( matrix_order == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ LAPACK_ztprfb( &side, &trans, &direct, &storev, &m, &n, &k, &l, v, &ldv, - t, &ldt, a, &lda, b, &ldb, mywork, &myldwork ); + t, &ldt, a, &lda, b, &ldb, work, &ldwork ); if( info < 0 ) { info = info - 1; } @@ -113,8 +113,8 @@ lapack_int LAPACKE_ztprfb_work( int matrix_order, char side, char trans, LAPACKE_zge_trans( matrix_order, m, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_ztprfb( &side, &trans, &direct, &storev, &m, &n, &k, &l, v_t, - &ldv_t, t_t, &ldt_t, a_t, &lda_t, b_t, &ldb_t, mywork, - &myldwork ); + &ldv_t, t_t, &ldt_t, a_t, &lda_t, b_t, &ldb_t, work, + &ldwork ); info = 0; /* LAPACK call is ok! */ /* Transpose output matrices */ LAPACKE_zge_trans( LAPACK_COL_MAJOR, k, m, a_t, lda_t, a, lda ); |