version 1.12, 2012/08/22 09:48:27
|
version 1.17, 2016/08/27 15:34:41
|
Line 1
|
Line 1
|
*> \brief \b DTGEX2 |
*> \brief \b DTGEX2 swaps adjacent diagonal blocks in an upper (quasi) triangular matrix pair by an orthogonal equivalence transformation. |
* |
* |
* =========== DOCUMENTATION =========== |
* =========== DOCUMENTATION =========== |
* |
* |
Line 181
|
Line 181
|
*> \author Univ. of Colorado Denver |
*> \author Univ. of Colorado Denver |
*> \author NAG Ltd. |
*> \author NAG Ltd. |
* |
* |
*> \date November 2011 |
*> \date November 2015 |
* |
* |
*> \ingroup doubleGEauxiliary |
*> \ingroup doubleGEauxiliary |
* |
* |
Line 221
|
Line 221
|
SUBROUTINE DTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z, |
SUBROUTINE DTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z, |
$ LDZ, J1, N1, N2, WORK, LWORK, INFO ) |
$ LDZ, J1, N1, N2, WORK, LWORK, INFO ) |
* |
* |
* -- LAPACK auxiliary routine (version 3.4.0) -- |
* -- LAPACK auxiliary routine (version 3.6.0) -- |
* -- LAPACK is a software package provided by Univ. of Tennessee, -- |
* -- LAPACK is a software package provided by Univ. of Tennessee, -- |
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- |
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- |
* November 2011 |
* November 2015 |
* |
* |
* .. Scalar Arguments .. |
* .. Scalar Arguments .. |
LOGICAL WANTQ, WANTZ |
LOGICAL WANTQ, WANTZ |
Line 595
|
Line 595
|
* |
* |
* Standardize existing 2-by-2 blocks. |
* Standardize existing 2-by-2 blocks. |
* |
* |
DO 50 I = 1, M*M |
CALL DLASET( 'Full', M, M, ZERO, ZERO, WORK, M ) |
WORK(I) = ZERO |
|
50 CONTINUE |
|
WORK( 1 ) = ONE |
WORK( 1 ) = ONE |
T( 1, 1 ) = ONE |
T( 1, 1 ) = ONE |
IDUM = LWORK - M*M - 2 |
IDUM = LWORK - M*M - 2 |
Line 668
|
Line 666
|
$ A( J1, I ), LDA, ZERO, WORK, M ) |
$ A( J1, I ), LDA, ZERO, WORK, M ) |
CALL DLACPY( 'Full', M, N-I+1, WORK, M, A( J1, I ), LDA ) |
CALL DLACPY( 'Full', M, N-I+1, WORK, M, A( J1, I ), LDA ) |
CALL DGEMM( 'T', 'N', M, N-I+1, M, ONE, LI, LDST, |
CALL DGEMM( 'T', 'N', M, N-I+1, M, ONE, LI, LDST, |
$ B( J1, I ), LDA, ZERO, WORK, M ) |
$ B( J1, I ), LDB, ZERO, WORK, M ) |
CALL DLACPY( 'Full', M, N-I+1, WORK, M, B( J1, I ), LDB ) |
CALL DLACPY( 'Full', M, N-I+1, WORK, M, B( J1, I ), LDB ) |
END IF |
END IF |
I = J1 - 1 |
I = J1 - 1 |