Annotation of rpl/lapack/lapack/ztrexc.f, revision 1.1.1.1
1.1 bertrand 1: SUBROUTINE ZTREXC( COMPQ, N, T, LDT, Q, LDQ, IFST, ILST, INFO )
2: *
3: * -- LAPACK routine (version 3.2) --
4: * -- LAPACK is a software package provided by Univ. of Tennessee, --
5: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
6: * November 2006
7: *
8: * .. Scalar Arguments ..
9: CHARACTER COMPQ
10: INTEGER IFST, ILST, INFO, LDQ, LDT, N
11: * ..
12: * .. Array Arguments ..
13: COMPLEX*16 Q( LDQ, * ), T( LDT, * )
14: * ..
15: *
16: * Purpose
17: * =======
18: *
19: * ZTREXC reorders the Schur factorization of a complex matrix
20: * A = Q*T*Q**H, so that the diagonal element of T with row index IFST
21: * is moved to row ILST.
22: *
23: * The Schur form T is reordered by a unitary similarity transformation
24: * Z**H*T*Z, and optionally the matrix Q of Schur vectors is updated by
25: * postmultplying it with Z.
26: *
27: * Arguments
28: * =========
29: *
30: * COMPQ (input) CHARACTER*1
31: * = 'V': update the matrix Q of Schur vectors;
32: * = 'N': do not update Q.
33: *
34: * N (input) INTEGER
35: * The order of the matrix T. N >= 0.
36: *
37: * T (input/output) COMPLEX*16 array, dimension (LDT,N)
38: * On entry, the upper triangular matrix T.
39: * On exit, the reordered upper triangular matrix.
40: *
41: * LDT (input) INTEGER
42: * The leading dimension of the array T. LDT >= max(1,N).
43: *
44: * Q (input/output) COMPLEX*16 array, dimension (LDQ,N)
45: * On entry, if COMPQ = 'V', the matrix Q of Schur vectors.
46: * On exit, if COMPQ = 'V', Q has been postmultiplied by the
47: * unitary transformation matrix Z which reorders T.
48: * If COMPQ = 'N', Q is not referenced.
49: *
50: * LDQ (input) INTEGER
51: * The leading dimension of the array Q. LDQ >= max(1,N).
52: *
53: * IFST (input) INTEGER
54: * ILST (input) INTEGER
55: * Specify the reordering of the diagonal elements of T:
56: * The element with row index IFST is moved to row ILST by a
57: * sequence of transpositions between adjacent elements.
58: * 1 <= IFST <= N; 1 <= ILST <= N.
59: *
60: * INFO (output) INTEGER
61: * = 0: successful exit
62: * < 0: if INFO = -i, the i-th argument had an illegal value
63: *
64: * =====================================================================
65: *
66: * .. Local Scalars ..
67: LOGICAL WANTQ
68: INTEGER K, M1, M2, M3
69: DOUBLE PRECISION CS
70: COMPLEX*16 SN, T11, T22, TEMP
71: * ..
72: * .. External Functions ..
73: LOGICAL LSAME
74: EXTERNAL LSAME
75: * ..
76: * .. External Subroutines ..
77: EXTERNAL XERBLA, ZLARTG, ZROT
78: * ..
79: * .. Intrinsic Functions ..
80: INTRINSIC DCONJG, MAX
81: * ..
82: * .. Executable Statements ..
83: *
84: * Decode and test the input parameters.
85: *
86: INFO = 0
87: WANTQ = LSAME( COMPQ, 'V' )
88: IF( .NOT.LSAME( COMPQ, 'N' ) .AND. .NOT.WANTQ ) THEN
89: INFO = -1
90: ELSE IF( N.LT.0 ) THEN
91: INFO = -2
92: ELSE IF( LDT.LT.MAX( 1, N ) ) THEN
93: INFO = -4
94: ELSE IF( LDQ.LT.1 .OR. ( WANTQ .AND. LDQ.LT.MAX( 1, N ) ) ) THEN
95: INFO = -6
96: ELSE IF( IFST.LT.1 .OR. IFST.GT.N ) THEN
97: INFO = -7
98: ELSE IF( ILST.LT.1 .OR. ILST.GT.N ) THEN
99: INFO = -8
100: END IF
101: IF( INFO.NE.0 ) THEN
102: CALL XERBLA( 'ZTREXC', -INFO )
103: RETURN
104: END IF
105: *
106: * Quick return if possible
107: *
108: IF( N.EQ.1 .OR. IFST.EQ.ILST )
109: $ RETURN
110: *
111: IF( IFST.LT.ILST ) THEN
112: *
113: * Move the IFST-th diagonal element forward down the diagonal.
114: *
115: M1 = 0
116: M2 = -1
117: M3 = 1
118: ELSE
119: *
120: * Move the IFST-th diagonal element backward up the diagonal.
121: *
122: M1 = -1
123: M2 = 0
124: M3 = -1
125: END IF
126: *
127: DO 10 K = IFST + M1, ILST + M2, M3
128: *
129: * Interchange the k-th and (k+1)-th diagonal elements.
130: *
131: T11 = T( K, K )
132: T22 = T( K+1, K+1 )
133: *
134: * Determine the transformation to perform the interchange.
135: *
136: CALL ZLARTG( T( K, K+1 ), T22-T11, CS, SN, TEMP )
137: *
138: * Apply transformation to the matrix T.
139: *
140: IF( K+2.LE.N )
141: $ CALL ZROT( N-K-1, T( K, K+2 ), LDT, T( K+1, K+2 ), LDT, CS,
142: $ SN )
143: CALL ZROT( K-1, T( 1, K ), 1, T( 1, K+1 ), 1, CS,
144: $ DCONJG( SN ) )
145: *
146: T( K, K ) = T22
147: T( K+1, K+1 ) = T11
148: *
149: IF( WANTQ ) THEN
150: *
151: * Accumulate transformation in the matrix Q.
152: *
153: CALL ZROT( N, Q( 1, K ), 1, Q( 1, K+1 ), 1, CS,
154: $ DCONJG( SN ) )
155: END IF
156: *
157: 10 CONTINUE
158: *
159: RETURN
160: *
161: * End of ZTREXC
162: *
163: END
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to ztrexc.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / lapack / lapack