![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to zgebak.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / lapack / lapack|
Return to zgebak.f CVS log | Up to [local] / rpl / lapack / lapack |
1.1 bertrand 1: SUBROUTINE ZGEBAK( JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV,
2: $ INFO )
3: *
4: * -- LAPACK routine (version 3.2) --
5: * -- LAPACK is a software package provided by Univ. of Tennessee, --
6: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
7: * November 2006
8: *
9: * .. Scalar Arguments ..
10: CHARACTER JOB, SIDE
11: INTEGER IHI, ILO, INFO, LDV, M, N
12: * ..
13: * .. Array Arguments ..
14: DOUBLE PRECISION SCALE( * )
15: COMPLEX*16 V( LDV, * )
16: * ..
17: *
18: * Purpose
19: * =======
20: *
21: * ZGEBAK forms the right or left eigenvectors of a complex general
22: * matrix by backward transformation on the computed eigenvectors of the
23: * balanced matrix output by ZGEBAL.
24: *
25: * Arguments
26: * =========
27: *
28: * JOB (input) CHARACTER*1
29: * Specifies the type of backward transformation required:
30: * = 'N', do nothing, return immediately;
31: * = 'P', do backward transformation for permutation only;
32: * = 'S', do backward transformation for scaling only;
33: * = 'B', do backward transformations for both permutation and
34: * scaling.
35: * JOB must be the same as the argument JOB supplied to ZGEBAL.
36: *
37: * SIDE (input) CHARACTER*1
38: * = 'R': V contains right eigenvectors;
39: * = 'L': V contains left eigenvectors.
40: *
41: * N (input) INTEGER
42: * The number of rows of the matrix V. N >= 0.
43: *
44: * ILO (input) INTEGER
45: * IHI (input) INTEGER
46: * The integers ILO and IHI determined by ZGEBAL.
47: * 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
48: *
49: * SCALE (input) DOUBLE PRECISION array, dimension (N)
50: * Details of the permutation and scaling factors, as returned
51: * by ZGEBAL.
52: *
53: * M (input) INTEGER
54: * The number of columns of the matrix V. M >= 0.
55: *
56: * V (input/output) COMPLEX*16 array, dimension (LDV,M)
57: * On entry, the matrix of right or left eigenvectors to be
58: * transformed, as returned by ZHSEIN or ZTREVC.
59: * On exit, V is overwritten by the transformed eigenvectors.
60: *
61: * LDV (input) INTEGER
62: * The leading dimension of the array V. LDV >= max(1,N).
63: *
64: * INFO (output) INTEGER
65: * = 0: successful exit
66: * < 0: if INFO = -i, the i-th argument had an illegal value.
67: *
68: * =====================================================================
69: *
70: * .. Parameters ..
71: DOUBLE PRECISION ONE
72: PARAMETER ( ONE = 1.0D+0 )
73: * ..
74: * .. Local Scalars ..
75: LOGICAL LEFTV, RIGHTV
76: INTEGER I, II, K
77: DOUBLE PRECISION S
78: * ..
79: * .. External Functions ..
80: LOGICAL LSAME
81: EXTERNAL LSAME
82: * ..
83: * .. External Subroutines ..
84: EXTERNAL XERBLA, ZDSCAL, ZSWAP
85: * ..
86: * .. Intrinsic Functions ..
87: INTRINSIC MAX, MIN
88: * ..
89: * .. Executable Statements ..
90: *
91: * Decode and Test the input parameters
92: *
93: RIGHTV = LSAME( SIDE, 'R' )
94: LEFTV = LSAME( SIDE, 'L' )
95: *
96: INFO = 0
97: IF( .NOT.LSAME( JOB, 'N' ) .AND. .NOT.LSAME( JOB, 'P' ) .AND.
98: $ .NOT.LSAME( JOB, 'S' ) .AND. .NOT.LSAME( JOB, 'B' ) ) THEN
99: INFO = -1
100: ELSE IF( .NOT.RIGHTV .AND. .NOT.LEFTV ) THEN
101: INFO = -2
102: ELSE IF( N.LT.0 ) THEN
103: INFO = -3
104: ELSE IF( ILO.LT.1 .OR. ILO.GT.MAX( 1, N ) ) THEN
105: INFO = -4
106: ELSE IF( IHI.LT.MIN( ILO, N ) .OR. IHI.GT.N ) THEN
107: INFO = -5
108: ELSE IF( M.LT.0 ) THEN
109: INFO = -7
110: ELSE IF( LDV.LT.MAX( 1, N ) ) THEN
111: INFO = -9
112: END IF
113: IF( INFO.NE.0 ) THEN
114: CALL XERBLA( 'ZGEBAK', -INFO )
115: RETURN
116: END IF
117: *
118: * Quick return if possible
119: *
120: IF( N.EQ.0 )
121: $ RETURN
122: IF( M.EQ.0 )
123: $ RETURN
124: IF( LSAME( JOB, 'N' ) )
125: $ RETURN
126: *
127: IF( ILO.EQ.IHI )
128: $ GO TO 30
129: *
130: * Backward balance
131: *
132: IF( LSAME( JOB, 'S' ) .OR. LSAME( JOB, 'B' ) ) THEN
133: *
134: IF( RIGHTV ) THEN
135: DO 10 I = ILO, IHI
136: S = SCALE( I )
137: CALL ZDSCAL( M, S, V( I, 1 ), LDV )
138: 10 CONTINUE
139: END IF
140: *
141: IF( LEFTV ) THEN
142: DO 20 I = ILO, IHI
143: S = ONE / SCALE( I )
144: CALL ZDSCAL( M, S, V( I, 1 ), LDV )
145: 20 CONTINUE
146: END IF
147: *
148: END IF
149: *
150: * Backward permutation
151: *
152: * For I = ILO-1 step -1 until 1,
153: * IHI+1 step 1 until N do --
154: *
155: 30 CONTINUE
156: IF( LSAME( JOB, 'P' ) .OR. LSAME( JOB, 'B' ) ) THEN
157: IF( RIGHTV ) THEN
158: DO 40 II = 1, N
159: I = II
160: IF( I.GE.ILO .AND. I.LE.IHI )
161: $ GO TO 40
162: IF( I.LT.ILO )
163: $ I = ILO - II
164: K = SCALE( I )
165: IF( K.EQ.I )
166: $ GO TO 40
167: CALL ZSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
168: 40 CONTINUE
169: END IF
170: *
171: IF( LEFTV ) THEN
172: DO 50 II = 1, N
173: I = II
174: IF( I.GE.ILO .AND. I.LE.IHI )
175: $ GO TO 50
176: IF( I.LT.ILO )
177: $ I = ILO - II
178: K = SCALE( I )
179: IF( K.EQ.I )
180: $ GO TO 50
181: CALL ZSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
182: 50 CONTINUE
183: END IF
184: END IF
185: *
186: RETURN
187: *
188: * End of ZGEBAK
189: *
190: END