diff --git a/lapack-netlib/SRC/ctgsen.f b/lapack-netlib/SRC/ctgsen.f index 180e96b322..2e79bfcc9b 100644 --- a/lapack-netlib/SRC/ctgsen.f +++ b/lapack-netlib/SRC/ctgsen.f @@ -5,7 +5,6 @@ * Online html documentation available at * http://www.netlib.org/lapack/explore-html/ * -*> \htmlonly *> Download CTGSEN + dependencies *> *> [TGZ] @@ -13,7 +12,6 @@ *> [ZIP] *> *> [TXT] -*> \endhtmlonly * * Definition: * =========== @@ -242,7 +240,7 @@ *> \verbatim *> LWORK is INTEGER *> The dimension of the array WORK. LWORK >= 1 -*> If IJOB = 1, 2 or 4, LWORK >= 2*M*(N-M) +*> If IJOB = 1, 2 or 4, LWORK >= 2*M*(N-M) + 1 *> If IJOB = 3 or 5, LWORK >= 4*M*(N-M) *> *> If LWORK = -1, then a workspace query is assumed; the routine @@ -427,9 +425,11 @@ *> 1996. *> * ===================================================================== - SUBROUTINE CTGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB, + SUBROUTINE CTGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, + $ LDB, $ ALPHA, BETA, Q, LDQ, Z, LDZ, M, PL, PR, DIF, $ WORK, LWORK, IWORK, LIWORK, INFO ) + IMPLICIT NONE * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -473,7 +473,8 @@ SUBROUTINE CTGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB, * .. * .. External Subroutines .. REAL SLAMCH - EXTERNAL CLACN2, CLACPY, CLASSQ, CSCAL, CTGEXC, CTGSYL, + EXTERNAL CLACN2, CLACPY, CLASSQ, CSCAL, CTGEXC, + $ CTGSYL, $ SLAMCH, XERBLA * .. * .. Intrinsic Functions .. @@ -531,7 +532,7 @@ SUBROUTINE CTGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB, END IF * IF( IJOB.EQ.1 .OR. IJOB.EQ.2 .OR. IJOB.EQ.4 ) THEN - LWMIN = MAX( 1, 2*M*(N-M) ) + LWMIN = MAX( 1, 2*M*(N-M) + 1 ) LIWMIN = MAX( 1, N+2 ) ELSE IF( IJOB.EQ.3 .OR. IJOB.EQ.5 ) THEN LWMIN = MAX( 1, 4*M*(N-M) ) @@ -593,7 +594,8 @@ SUBROUTINE CTGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB, * and Z that will swap adjacent diagonal blocks in (A, B). * IF( K.NE.KS ) - $ CALL CTGEXC( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z, + $ CALL CTGEXC( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, + $ Z, $ LDZ, K, KS, IERR ) * IF( IERR.GT.0 ) THEN @@ -623,7 +625,8 @@ SUBROUTINE CTGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB, N2 = N - M I = N1 + 1 CALL CLACPY( 'Full', N1, N2, A( 1, I ), LDA, WORK, N1 ) - CALL CLACPY( 'Full', N1, N2, B( 1, I ), LDB, WORK( N1*N2+1 ), + CALL CLACPY( 'Full', N1, N2, B( 1, I ), LDB, + $ WORK( N1*N2+1 ), $ N1 ) IJB = 0 CALL CTGSYL( 'N', IJB, N1, N2, A, LDA, A( I, I ), LDA, WORK, @@ -665,14 +668,16 @@ SUBROUTINE CTGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB, * * Frobenius norm-based Difu estimate. * - CALL CTGSYL( 'N', IJB, N1, N2, A, LDA, A( I, I ), LDA, WORK, + CALL CTGSYL( 'N', IJB, N1, N2, A, LDA, A( I, I ), LDA, + $ WORK, $ N1, B, LDB, B( I, I ), LDB, WORK( N1*N2+1 ), $ N1, DSCALE, DIF( 1 ), WORK( N1*N2*2+1 ), $ LWORK-2*N1*N2, IWORK, IERR ) * * Frobenius norm-based Difl estimate. * - CALL CTGSYL( 'N', IJB, N2, N1, A( I, I ), LDA, A, LDA, WORK, + CALL CTGSYL( 'N', IJB, N2, N1, A( I, I ), LDA, A, LDA, + $ WORK, $ N2, B( I, I ), LDB, B, LDB, WORK( N1*N2+1 ), $ N2, DSCALE, DIF( 2 ), WORK( N1*N2*2+1 ), $ LWORK-2*N1*N2, IWORK, IERR ) @@ -700,7 +705,8 @@ SUBROUTINE CTGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB, * * Solve generalized Sylvester equation * - CALL CTGSYL( 'N', IJB, N1, N2, A, LDA, A( I, I ), LDA, + CALL CTGSYL( 'N', IJB, N1, N2, A, LDA, A( I, I ), + $ LDA, $ WORK, N1, B, LDB, B( I, I ), LDB, $ WORK( N1*N2+1 ), N1, DSCALE, DIF( 1 ), $ WORK( N1*N2*2+1 ), LWORK-2*N1*N2, IWORK, @@ -709,7 +715,8 @@ SUBROUTINE CTGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB, * * Solve the transposed variant. * - CALL CTGSYL( 'C', IJB, N1, N2, A, LDA, A( I, I ), LDA, + CALL CTGSYL( 'C', IJB, N1, N2, A, LDA, A( I, I ), + $ LDA, $ WORK, N1, B, LDB, B( I, I ), LDB, $ WORK( N1*N2+1 ), N1, DSCALE, DIF( 1 ), $ WORK( N1*N2*2+1 ), LWORK-2*N1*N2, IWORK, @@ -729,7 +736,8 @@ SUBROUTINE CTGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB, * * Solve generalized Sylvester equation * - CALL CTGSYL( 'N', IJB, N2, N1, A( I, I ), LDA, A, LDA, + CALL CTGSYL( 'N', IJB, N2, N1, A( I, I ), LDA, A, + $ LDA, $ WORK, N2, B( I, I ), LDB, B, LDB, $ WORK( N1*N2+1 ), N2, DSCALE, DIF( 2 ), $ WORK( N1*N2*2+1 ), LWORK-2*N1*N2, IWORK, @@ -738,7 +746,8 @@ SUBROUTINE CTGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB, * * Solve the transposed variant. * - CALL CTGSYL( 'C', IJB, N2, N1, A( I, I ), LDA, A, LDA, + CALL CTGSYL( 'C', IJB, N2, N1, A( I, I ), LDA, A, + $ LDA, $ WORK, N2, B, LDB, B( I, I ), LDB, $ WORK( N1*N2+1 ), N2, DSCALE, DIF( 2 ), $ WORK( N1*N2*2+1 ), LWORK-2*N1*N2, IWORK, diff --git a/lapack-netlib/SRC/dtgsen.f b/lapack-netlib/SRC/dtgsen.f index 8de66b6a17..d793df7129 100644 --- a/lapack-netlib/SRC/dtgsen.f +++ b/lapack-netlib/SRC/dtgsen.f @@ -5,7 +5,6 @@ * Online html documentation available at * http://www.netlib.org/lapack/explore-html/ * -*> \htmlonly *> Download DTGSEN + dependencies *> *> [TGZ] @@ -13,7 +12,6 @@ *> [ZIP] *> *> [TXT] -*> \endhtmlonly * * Definition: * =========== @@ -256,7 +254,7 @@ *> \verbatim *> LWORK is INTEGER *> The dimension of the array WORK. LWORK >= 4*N+16. -*> If IJOB = 1, 2 or 4, LWORK >= MAX(4*N+16, 2*M*(N-M)). +*> If IJOB = 1, 2 or 4, LWORK >= MAX(4*N+16, 2*M*(N-M) + 1). *> If IJOB = 3 or 5, LWORK >= MAX(4*N+16, 4*M*(N-M)). *> *> If LWORK = -1, then a workspace query is assumed; the routine @@ -304,7 +302,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \ingroup doubleOTHERcomputational +*> \ingroup tgsen * *> \par Further Details: * ===================== @@ -445,9 +443,11 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE DTGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB, + SUBROUTINE DTGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, + $ LDB, $ ALPHAR, ALPHAI, BETA, Q, LDQ, Z, LDZ, M, PL, $ PR, DIF, WORK, LWORK, IWORK, LIWORK, INFO ) + IMPLICIT NONE * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -486,7 +486,8 @@ SUBROUTINE DTGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB, INTEGER ISAVE( 3 ) * .. * .. External Subroutines .. - EXTERNAL DLACN2, DLACPY, DLAG2, DLASSQ, DTGEXC, DTGSYL, + EXTERNAL DLACN2, DLACPY, DLAG2, DLASSQ, DTGEXC, + $ DTGSYL, $ XERBLA * .. * .. External Functions .. @@ -561,7 +562,7 @@ SUBROUTINE DTGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB, END IF * IF( IJOB.EQ.1 .OR. IJOB.EQ.2 .OR. IJOB.EQ.4 ) THEN - LWMIN = MAX( 1, 4*N+16, 2*M*( N-M ) ) + LWMIN = MAX( 1, 4*N+16, 2*M*( N-M ) + 1 ) LIWMIN = MAX( 1, N+6 ) ELSE IF( IJOB.EQ.3 .OR. IJOB.EQ.5 ) THEN LWMIN = MAX( 1, 4*N+16, 4*M*( N-M ) ) @@ -634,7 +635,8 @@ SUBROUTINE DTGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB, * KK = K IF( K.NE.KS ) - $ CALL DTGEXC( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, + $ CALL DTGEXC( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, + $ LDQ, $ Z, LDZ, KK, KS, WORK, LWORK, IERR ) * IF( IERR.GT.0 ) THEN @@ -668,7 +670,8 @@ SUBROUTINE DTGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB, I = N1 + 1 IJB = 0 CALL DLACPY( 'Full', N1, N2, A( 1, I ), LDA, WORK, N1 ) - CALL DLACPY( 'Full', N1, N2, B( 1, I ), LDB, WORK( N1*N2+1 ), + CALL DLACPY( 'Full', N1, N2, B( 1, I ), LDB, + $ WORK( N1*N2+1 ), $ N1 ) CALL DTGSYL( 'N', IJB, N1, N2, A, LDA, A( I, I ), LDA, WORK, $ N1, B, LDB, B( I, I ), LDB, WORK( N1*N2+1 ), N1, @@ -710,14 +713,16 @@ SUBROUTINE DTGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB, * * Frobenius norm-based Difu-estimate. * - CALL DTGSYL( 'N', IJB, N1, N2, A, LDA, A( I, I ), LDA, WORK, + CALL DTGSYL( 'N', IJB, N1, N2, A, LDA, A( I, I ), LDA, + $ WORK, $ N1, B, LDB, B( I, I ), LDB, WORK( N1*N2+1 ), $ N1, DSCALE, DIF( 1 ), WORK( 2*N1*N2+1 ), $ LWORK-2*N1*N2, IWORK, IERR ) * * Frobenius norm-based Difl-estimate. * - CALL DTGSYL( 'N', IJB, N2, N1, A( I, I ), LDA, A, LDA, WORK, + CALL DTGSYL( 'N', IJB, N2, N1, A( I, I ), LDA, A, LDA, + $ WORK, $ N2, B( I, I ), LDB, B, LDB, WORK( N1*N2+1 ), $ N2, DSCALE, DIF( 2 ), WORK( 2*N1*N2+1 ), $ LWORK-2*N1*N2, IWORK, IERR ) @@ -746,7 +751,8 @@ SUBROUTINE DTGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB, * * Solve generalized Sylvester equation. * - CALL DTGSYL( 'N', IJB, N1, N2, A, LDA, A( I, I ), LDA, + CALL DTGSYL( 'N', IJB, N1, N2, A, LDA, A( I, I ), + $ LDA, $ WORK, N1, B, LDB, B( I, I ), LDB, $ WORK( N1*N2+1 ), N1, DSCALE, DIF( 1 ), $ WORK( 2*N1*N2+1 ), LWORK-2*N1*N2, IWORK, @@ -755,7 +761,8 @@ SUBROUTINE DTGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB, * * Solve the transposed variant. * - CALL DTGSYL( 'T', IJB, N1, N2, A, LDA, A( I, I ), LDA, + CALL DTGSYL( 'T', IJB, N1, N2, A, LDA, A( I, I ), + $ LDA, $ WORK, N1, B, LDB, B( I, I ), LDB, $ WORK( N1*N2+1 ), N1, DSCALE, DIF( 1 ), $ WORK( 2*N1*N2+1 ), LWORK-2*N1*N2, IWORK, @@ -775,7 +782,8 @@ SUBROUTINE DTGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB, * * Solve generalized Sylvester equation. * - CALL DTGSYL( 'N', IJB, N2, N1, A( I, I ), LDA, A, LDA, + CALL DTGSYL( 'N', IJB, N2, N1, A( I, I ), LDA, A, + $ LDA, $ WORK, N2, B( I, I ), LDB, B, LDB, $ WORK( N1*N2+1 ), N2, DSCALE, DIF( 2 ), $ WORK( 2*N1*N2+1 ), LWORK-2*N1*N2, IWORK, @@ -784,7 +792,8 @@ SUBROUTINE DTGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB, * * Solve the transposed variant. * - CALL DTGSYL( 'T', IJB, N2, N1, A( I, I ), LDA, A, LDA, + CALL DTGSYL( 'T', IJB, N2, N1, A( I, I ), LDA, A, + $ LDA, $ WORK, N2, B( I, I ), LDB, B, LDB, $ WORK( N1*N2+1 ), N2, DSCALE, DIF( 2 ), $ WORK( 2*N1*N2+1 ), LWORK-2*N1*N2, IWORK, @@ -826,7 +835,8 @@ SUBROUTINE DTGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB, WORK( 6 ) = B( K+1, K ) WORK( 7 ) = B( K, K+1 ) WORK( 8 ) = B( K+1, K+1 ) - CALL DLAG2( WORK, 2, WORK( 5 ), 2, SMLNUM*EPS, BETA( K ), + CALL DLAG2( WORK, 2, WORK( 5 ), 2, SMLNUM*EPS, + $ BETA( K ), $ BETA( K+1 ), ALPHAR( K ), ALPHAR( K+1 ), $ ALPHAI( K ) ) ALPHAI( K+1 ) = -ALPHAI( K ) diff --git a/lapack-netlib/SRC/stgsen.f b/lapack-netlib/SRC/stgsen.f index ac9c4677ad..6584cebdab 100644 --- a/lapack-netlib/SRC/stgsen.f +++ b/lapack-netlib/SRC/stgsen.f @@ -5,7 +5,6 @@ * Online html documentation available at * http://www.netlib.org/lapack/explore-html/ * -*> \htmlonly *> Download STGSEN + dependencies *> *> [TGZ] @@ -13,7 +12,6 @@ *> [ZIP] *> *> [TXT] -*> \endhtmlonly * * Definition: * =========== @@ -256,7 +254,7 @@ *> \verbatim *> LWORK is INTEGER *> The dimension of the array WORK. LWORK >= 4*N+16. -*> If IJOB = 1, 2 or 4, LWORK >= MAX(4*N+16, 2*M*(N-M)). +*> If IJOB = 1, 2 or 4, LWORK >= MAX(4*N+16, 2*M*(N-M) + 1). *> If IJOB = 3 or 5, LWORK >= MAX(4*N+16, 4*M*(N-M)). *> *> If LWORK = -1, then a workspace query is assumed; the routine @@ -445,9 +443,11 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE STGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB, + SUBROUTINE STGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, + $ LDB, $ ALPHAR, ALPHAI, BETA, Q, LDQ, Z, LDZ, M, PL, $ PR, DIF, WORK, LWORK, IWORK, LIWORK, INFO ) + IMPLICIT NONE * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -486,7 +486,8 @@ SUBROUTINE STGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB, INTEGER ISAVE( 3 ) * .. * .. External Subroutines .. - EXTERNAL SLACN2, SLACPY, SLAG2, SLASSQ, STGEXC, STGSYL, + EXTERNAL SLACN2, SLACPY, SLAG2, SLASSQ, STGEXC, + $ STGSYL, $ XERBLA * .. * .. External Functions .. @@ -561,7 +562,7 @@ SUBROUTINE STGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB, END IF * IF( IJOB.EQ.1 .OR. IJOB.EQ.2 .OR. IJOB.EQ.4 ) THEN - LWMIN = MAX( 1, 4*N+16, 2*M*(N-M) ) + LWMIN = MAX( 1, 4*N+16, 2*M*(N-M) + 1 ) LIWMIN = MAX( 1, N+6 ) ELSE IF( IJOB.EQ.3 .OR. IJOB.EQ.5 ) THEN LWMIN = MAX( 1, 4*N+16, 4*M*(N-M) ) @@ -634,7 +635,8 @@ SUBROUTINE STGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB, * KK = K IF( K.NE.KS ) - $ CALL STGEXC( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, + $ CALL STGEXC( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, + $ LDQ, $ Z, LDZ, KK, KS, WORK, LWORK, IERR ) * IF( IERR.GT.0 ) THEN @@ -668,7 +670,8 @@ SUBROUTINE STGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB, I = N1 + 1 IJB = 0 CALL SLACPY( 'Full', N1, N2, A( 1, I ), LDA, WORK, N1 ) - CALL SLACPY( 'Full', N1, N2, B( 1, I ), LDB, WORK( N1*N2+1 ), + CALL SLACPY( 'Full', N1, N2, B( 1, I ), LDB, + $ WORK( N1*N2+1 ), $ N1 ) CALL STGSYL( 'N', IJB, N1, N2, A, LDA, A( I, I ), LDA, WORK, $ N1, B, LDB, B( I, I ), LDB, WORK( N1*N2+1 ), N1, @@ -710,14 +713,16 @@ SUBROUTINE STGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB, * * Frobenius norm-based Difu-estimate. * - CALL STGSYL( 'N', IJB, N1, N2, A, LDA, A( I, I ), LDA, WORK, + CALL STGSYL( 'N', IJB, N1, N2, A, LDA, A( I, I ), LDA, + $ WORK, $ N1, B, LDB, B( I, I ), LDB, WORK( N1*N2+1 ), $ N1, DSCALE, DIF( 1 ), WORK( 2*N1*N2+1 ), $ LWORK-2*N1*N2, IWORK, IERR ) * * Frobenius norm-based Difl-estimate. * - CALL STGSYL( 'N', IJB, N2, N1, A( I, I ), LDA, A, LDA, WORK, + CALL STGSYL( 'N', IJB, N2, N1, A( I, I ), LDA, A, LDA, + $ WORK, $ N2, B( I, I ), LDB, B, LDB, WORK( N1*N2+1 ), $ N2, DSCALE, DIF( 2 ), WORK( 2*N1*N2+1 ), $ LWORK-2*N1*N2, IWORK, IERR ) @@ -746,7 +751,8 @@ SUBROUTINE STGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB, * * Solve generalized Sylvester equation. * - CALL STGSYL( 'N', IJB, N1, N2, A, LDA, A( I, I ), LDA, + CALL STGSYL( 'N', IJB, N1, N2, A, LDA, A( I, I ), + $ LDA, $ WORK, N1, B, LDB, B( I, I ), LDB, $ WORK( N1*N2+1 ), N1, DSCALE, DIF( 1 ), $ WORK( 2*N1*N2+1 ), LWORK-2*N1*N2, IWORK, @@ -755,7 +761,8 @@ SUBROUTINE STGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB, * * Solve the transposed variant. * - CALL STGSYL( 'T', IJB, N1, N2, A, LDA, A( I, I ), LDA, + CALL STGSYL( 'T', IJB, N1, N2, A, LDA, A( I, I ), + $ LDA, $ WORK, N1, B, LDB, B( I, I ), LDB, $ WORK( N1*N2+1 ), N1, DSCALE, DIF( 1 ), $ WORK( 2*N1*N2+1 ), LWORK-2*N1*N2, IWORK, @@ -775,7 +782,8 @@ SUBROUTINE STGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB, * * Solve generalized Sylvester equation. * - CALL STGSYL( 'N', IJB, N2, N1, A( I, I ), LDA, A, LDA, + CALL STGSYL( 'N', IJB, N2, N1, A( I, I ), LDA, A, + $ LDA, $ WORK, N2, B( I, I ), LDB, B, LDB, $ WORK( N1*N2+1 ), N2, DSCALE, DIF( 2 ), $ WORK( 2*N1*N2+1 ), LWORK-2*N1*N2, IWORK, @@ -784,7 +792,8 @@ SUBROUTINE STGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB, * * Solve the transposed variant. * - CALL STGSYL( 'T', IJB, N2, N1, A( I, I ), LDA, A, LDA, + CALL STGSYL( 'T', IJB, N2, N1, A( I, I ), LDA, A, + $ LDA, $ WORK, N2, B( I, I ), LDB, B, LDB, $ WORK( N1*N2+1 ), N2, DSCALE, DIF( 2 ), $ WORK( 2*N1*N2+1 ), LWORK-2*N1*N2, IWORK, @@ -826,7 +835,8 @@ SUBROUTINE STGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB, WORK( 6 ) = B( K+1, K ) WORK( 7 ) = B( K, K+1 ) WORK( 8 ) = B( K+1, K+1 ) - CALL SLAG2( WORK, 2, WORK( 5 ), 2, SMLNUM*EPS, BETA( K ), + CALL SLAG2( WORK, 2, WORK( 5 ), 2, SMLNUM*EPS, + $ BETA( K ), $ BETA( K+1 ), ALPHAR( K ), ALPHAR( K+1 ), $ ALPHAI( K ) ) ALPHAI( K+1 ) = -ALPHAI( K ) diff --git a/lapack-netlib/SRC/ztgsen.f b/lapack-netlib/SRC/ztgsen.f index 25a5c6f4ed..84b69c2fe0 100644 --- a/lapack-netlib/SRC/ztgsen.f +++ b/lapack-netlib/SRC/ztgsen.f @@ -5,7 +5,6 @@ * Online html documentation available at * http://www.netlib.org/lapack/explore-html/ * -*> \htmlonly *> Download ZTGSEN + dependencies *> *> [TGZ] @@ -13,7 +12,6 @@ *> [ZIP] *> *> [TXT] -*> \endhtmlonly * * Definition: * =========== @@ -242,7 +240,7 @@ *> \verbatim *> LWORK is INTEGER *> The dimension of the array WORK. LWORK >= 1 -*> If IJOB = 1, 2 or 4, LWORK >= 2*M*(N-M) +*> If IJOB = 1, 2 or 4, LWORK >= 2*M*(N-M) + 1 *> If IJOB = 3 or 5, LWORK >= 4*M*(N-M) *> *> If LWORK = -1, then a workspace query is assumed; the routine @@ -290,7 +288,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \ingroup complex16OTHERcomputational +*> \ingroup tgsen * *> \par Further Details: * ===================== @@ -427,9 +425,11 @@ *> 1996. *> * ===================================================================== - SUBROUTINE ZTGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB, + SUBROUTINE ZTGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, + $ LDB, $ ALPHA, BETA, Q, LDQ, Z, LDZ, M, PL, PR, DIF, $ WORK, LWORK, IWORK, LIWORK, INFO ) + IMPLICIT NONE * * -- LAPACK computational routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -468,7 +468,8 @@ SUBROUTINE ZTGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB, INTEGER ISAVE( 3 ) * .. * .. External Subroutines .. - EXTERNAL XERBLA, ZLACN2, ZLACPY, ZLASSQ, ZSCAL, ZTGEXC, + EXTERNAL XERBLA, ZLACN2, ZLACPY, ZLASSQ, ZSCAL, + $ ZTGEXC, $ ZTGSYL * .. * .. Intrinsic Functions .. @@ -530,7 +531,7 @@ SUBROUTINE ZTGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB, END IF * IF( IJOB.EQ.1 .OR. IJOB.EQ.2 .OR. IJOB.EQ.4 ) THEN - LWMIN = MAX( 1, 2*M*( N-M ) ) + LWMIN = MAX( 1, 2*M*( N-M ) + 1 ) LIWMIN = MAX( 1, N+2 ) ELSE IF( IJOB.EQ.3 .OR. IJOB.EQ.5 ) THEN LWMIN = MAX( 1, 4*M*( N-M ) ) @@ -592,7 +593,8 @@ SUBROUTINE ZTGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB, * and Z that will swap adjacent diagonal blocks in (A, B). * IF( K.NE.KS ) - $ CALL ZTGEXC( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z, + $ CALL ZTGEXC( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, + $ Z, $ LDZ, K, KS, IERR ) * IF( IERR.GT.0 ) THEN @@ -622,7 +624,8 @@ SUBROUTINE ZTGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB, N2 = N - M I = N1 + 1 CALL ZLACPY( 'Full', N1, N2, A( 1, I ), LDA, WORK, N1 ) - CALL ZLACPY( 'Full', N1, N2, B( 1, I ), LDB, WORK( N1*N2+1 ), + CALL ZLACPY( 'Full', N1, N2, B( 1, I ), LDB, + $ WORK( N1*N2+1 ), $ N1 ) IJB = 0 CALL ZTGSYL( 'N', IJB, N1, N2, A, LDA, A( I, I ), LDA, WORK, @@ -664,14 +667,16 @@ SUBROUTINE ZTGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB, * * Frobenius norm-based Difu estimate. * - CALL ZTGSYL( 'N', IJB, N1, N2, A, LDA, A( I, I ), LDA, WORK, + CALL ZTGSYL( 'N', IJB, N1, N2, A, LDA, A( I, I ), LDA, + $ WORK, $ N1, B, LDB, B( I, I ), LDB, WORK( N1*N2+1 ), $ N1, DSCALE, DIF( 1 ), WORK( N1*N2*2+1 ), $ LWORK-2*N1*N2, IWORK, IERR ) * * Frobenius norm-based Difl estimate. * - CALL ZTGSYL( 'N', IJB, N2, N1, A( I, I ), LDA, A, LDA, WORK, + CALL ZTGSYL( 'N', IJB, N2, N1, A( I, I ), LDA, A, LDA, + $ WORK, $ N2, B( I, I ), LDB, B, LDB, WORK( N1*N2+1 ), $ N2, DSCALE, DIF( 2 ), WORK( N1*N2*2+1 ), $ LWORK-2*N1*N2, IWORK, IERR ) @@ -699,7 +704,8 @@ SUBROUTINE ZTGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB, * * Solve generalized Sylvester equation * - CALL ZTGSYL( 'N', IJB, N1, N2, A, LDA, A( I, I ), LDA, + CALL ZTGSYL( 'N', IJB, N1, N2, A, LDA, A( I, I ), + $ LDA, $ WORK, N1, B, LDB, B( I, I ), LDB, $ WORK( N1*N2+1 ), N1, DSCALE, DIF( 1 ), $ WORK( N1*N2*2+1 ), LWORK-2*N1*N2, IWORK, @@ -708,7 +714,8 @@ SUBROUTINE ZTGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB, * * Solve the transposed variant. * - CALL ZTGSYL( 'C', IJB, N1, N2, A, LDA, A( I, I ), LDA, + CALL ZTGSYL( 'C', IJB, N1, N2, A, LDA, A( I, I ), + $ LDA, $ WORK, N1, B, LDB, B( I, I ), LDB, $ WORK( N1*N2+1 ), N1, DSCALE, DIF( 1 ), $ WORK( N1*N2*2+1 ), LWORK-2*N1*N2, IWORK, @@ -728,7 +735,8 @@ SUBROUTINE ZTGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB, * * Solve generalized Sylvester equation * - CALL ZTGSYL( 'N', IJB, N2, N1, A( I, I ), LDA, A, LDA, + CALL ZTGSYL( 'N', IJB, N2, N1, A( I, I ), LDA, A, + $ LDA, $ WORK, N2, B( I, I ), LDB, B, LDB, $ WORK( N1*N2+1 ), N2, DSCALE, DIF( 2 ), $ WORK( N1*N2*2+1 ), LWORK-2*N1*N2, IWORK, @@ -737,7 +745,8 @@ SUBROUTINE ZTGSEN( IJOB, WANTQ, WANTZ, SELECT, N, A, LDA, B, LDB, * * Solve the transposed variant. * - CALL ZTGSYL( 'C', IJB, N2, N1, A( I, I ), LDA, A, LDA, + CALL ZTGSYL( 'C', IJB, N2, N1, A( I, I ), LDA, A, + $ LDA, $ WORK, N2, B, LDB, B( I, I ), LDB, $ WORK( N1*N2+1 ), N2, DSCALE, DIF( 2 ), $ WORK( N1*N2*2+1 ), LWORK-2*N1*N2, IWORK,