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
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