diff options
Diffstat (limited to 'src/lib/lapack/ztrexc.f')
| -rw-r--r-- | src/lib/lapack/ztrexc.f | 162 |
1 files changed, 0 insertions, 162 deletions
diff --git a/src/lib/lapack/ztrexc.f b/src/lib/lapack/ztrexc.f deleted file mode 100644 index 69313696..00000000 --- a/src/lib/lapack/ztrexc.f +++ /dev/null @@ -1,162 +0,0 @@ - SUBROUTINE ZTREXC( COMPQ, N, T, LDT, Q, LDQ, IFST, ILST, INFO ) -* -* -- LAPACK routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER COMPQ - INTEGER IFST, ILST, INFO, LDQ, LDT, N -* .. -* .. Array Arguments .. - COMPLEX*16 Q( LDQ, * ), T( LDT, * ) -* .. -* -* Purpose -* ======= -* -* ZTREXC reorders the Schur factorization of a complex matrix -* A = Q*T*Q**H, so that the diagonal element of T with row index IFST -* is moved to row ILST. -* -* The Schur form T is reordered by a unitary similarity transformation -* Z**H*T*Z, and optionally the matrix Q of Schur vectors is updated by -* postmultplying it with Z. -* -* Arguments -* ========= -* -* COMPQ (input) CHARACTER*1 -* = 'V': update the matrix Q of Schur vectors; -* = 'N': do not update Q. -* -* N (input) INTEGER -* The order of the matrix T. N >= 0. -* -* T (input/output) COMPLEX*16 array, dimension (LDT,N) -* On entry, the upper triangular matrix T. -* On exit, the reordered upper triangular matrix. -* -* LDT (input) INTEGER -* The leading dimension of the array T. LDT >= max(1,N). -* -* Q (input/output) COMPLEX*16 array, dimension (LDQ,N) -* On entry, if COMPQ = 'V', the matrix Q of Schur vectors. -* On exit, if COMPQ = 'V', Q has been postmultiplied by the -* unitary transformation matrix Z which reorders T. -* If COMPQ = 'N', Q is not referenced. -* -* LDQ (input) INTEGER -* The leading dimension of the array Q. LDQ >= max(1,N). -* -* IFST (input) INTEGER -* ILST (input) INTEGER -* Specify the reordering of the diagonal elements of T: -* The element with row index IFST is moved to row ILST by a -* sequence of transpositions between adjacent elements. -* 1 <= IFST <= N; 1 <= ILST <= N. -* -* INFO (output) INTEGER -* = 0: successful exit -* < 0: if INFO = -i, the i-th argument had an illegal value -* -* ===================================================================== -* -* .. Local Scalars .. - LOGICAL WANTQ - INTEGER K, M1, M2, M3 - DOUBLE PRECISION CS - COMPLEX*16 SN, T11, T22, TEMP -* .. -* .. External Functions .. - LOGICAL LSAME - EXTERNAL LSAME -* .. -* .. External Subroutines .. - EXTERNAL XERBLA, ZLARTG, ZROT -* .. -* .. Intrinsic Functions .. - INTRINSIC DCONJG, MAX -* .. -* .. Executable Statements .. -* -* Decode and test the input parameters. -* - INFO = 0 - WANTQ = LSAME( COMPQ, 'V' ) - IF( .NOT.LSAME( COMPQ, 'N' ) .AND. .NOT.WANTQ ) THEN - INFO = -1 - ELSE IF( N.LT.0 ) THEN - INFO = -2 - ELSE IF( LDT.LT.MAX( 1, N ) ) THEN - INFO = -4 - ELSE IF( LDQ.LT.1 .OR. ( WANTQ .AND. LDQ.LT.MAX( 1, N ) ) ) THEN - INFO = -6 - ELSE IF( IFST.LT.1 .OR. IFST.GT.N ) THEN - INFO = -7 - ELSE IF( ILST.LT.1 .OR. ILST.GT.N ) THEN - INFO = -8 - END IF - IF( INFO.NE.0 ) THEN - CALL XERBLA( 'ZTREXC', -INFO ) - RETURN - END IF -* -* Quick return if possible -* - IF( N.EQ.1 .OR. IFST.EQ.ILST ) - $ RETURN -* - IF( IFST.LT.ILST ) THEN -* -* Move the IFST-th diagonal element forward down the diagonal. -* - M1 = 0 - M2 = -1 - M3 = 1 - ELSE -* -* Move the IFST-th diagonal element backward up the diagonal. -* - M1 = -1 - M2 = 0 - M3 = -1 - END IF -* - DO 10 K = IFST + M1, ILST + M2, M3 -* -* Interchange the k-th and (k+1)-th diagonal elements. -* - T11 = T( K, K ) - T22 = T( K+1, K+1 ) -* -* Determine the transformation to perform the interchange. -* - CALL ZLARTG( T( K, K+1 ), T22-T11, CS, SN, TEMP ) -* -* Apply transformation to the matrix T. -* - IF( K+2.LE.N ) - $ CALL ZROT( N-K-1, T( K, K+2 ), LDT, T( K+1, K+2 ), LDT, CS, - $ SN ) - CALL ZROT( K-1, T( 1, K ), 1, T( 1, K+1 ), 1, CS, - $ DCONJG( SN ) ) -* - T( K, K ) = T22 - T( K+1, K+1 ) = T11 -* - IF( WANTQ ) THEN -* -* Accumulate transformation in the matrix Q. -* - CALL ZROT( N, Q( 1, K ), 1, Q( 1, K+1 ), 1, CS, - $ DCONJG( SN ) ) - END IF -* - 10 CONTINUE -* - RETURN -* -* End of ZTREXC -* - END |