diff --git a/lapack-netlib/SRC/dtgsen.f b/lapack-netlib/SRC/dtgsen.f index 8de66b6a1..d793df712 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 @@ 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 @@ 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 @@ * 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 @@ 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 @@ * * 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 @@ * * 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 @@ * * 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 @@ * * 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 @@ * * 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 @@ 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/ztgsen.f b/lapack-netlib/SRC/ztgsen.f index 25a5c6f4e..84b69c2fe 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 @@ 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 @@ 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 @@ * 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 @@ 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 @@ * * 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 @@ * * 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 @@ * * 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 @@ * * 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 @@ * * 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,