LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
cggbak.f
Go to the documentation of this file.
1 *> \brief \b CGGBAK
2 *
3 * =========== DOCUMENTATION ===========
4 *
5 * Online html documentation available at
6 * http://www.netlib.org/lapack/explore-html/
7 *
8 *> \htmlonly
9 *> Download CGGBAK + dependencies
10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cggbak.f">
11 *> [TGZ]</a>
12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/cggbak.f">
13 *> [ZIP]</a>
14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cggbak.f">
15 *> [TXT]</a>
16 *> \endhtmlonly
17 *
18 * Definition:
19 * ===========
20 *
21 * SUBROUTINE CGGBAK( JOB, SIDE, N, ILO, IHI, LSCALE, RSCALE, M, V,
22 * LDV, INFO )
23 *
24 * .. Scalar Arguments ..
25 * CHARACTER JOB, SIDE
26 * INTEGER IHI, ILO, INFO, LDV, M, N
27 * ..
28 * .. Array Arguments ..
29 * REAL LSCALE( * ), RSCALE( * )
30 * COMPLEX V( LDV, * )
31 * ..
32 *
33 *
34 *> \par Purpose:
35 * =============
36 *>
37 *> \verbatim
38 *>
39 *> CGGBAK forms the right or left eigenvectors of a complex generalized
40 *> eigenvalue problem A*x = lambda*B*x, by backward transformation on
41 *> the computed eigenvectors of the balanced pair of matrices output by
42 *> CGGBAL.
43 *> \endverbatim
44 *
45 * Arguments:
46 * ==========
47 *
48 *> \param[in] JOB
49 *> \verbatim
50 *> JOB is CHARACTER*1
51 *> Specifies the type of backward transformation required:
52 *> = 'N': do nothing, return immediately;
53 *> = 'P': do backward transformation for permutation only;
54 *> = 'S': do backward transformation for scaling only;
55 *> = 'B': do backward transformations for both permutation and
56 *> scaling.
57 *> JOB must be the same as the argument JOB supplied to CGGBAL.
58 *> \endverbatim
59 *>
60 *> \param[in] SIDE
61 *> \verbatim
62 *> SIDE is CHARACTER*1
63 *> = 'R': V contains right eigenvectors;
64 *> = 'L': V contains left eigenvectors.
65 *> \endverbatim
66 *>
67 *> \param[in] N
68 *> \verbatim
69 *> N is INTEGER
70 *> The number of rows of the matrix V. N >= 0.
71 *> \endverbatim
72 *>
73 *> \param[in] ILO
74 *> \verbatim
75 *> ILO is INTEGER
76 *> \endverbatim
77 *>
78 *> \param[in] IHI
79 *> \verbatim
80 *> IHI is INTEGER
81 *> The integers ILO and IHI determined by CGGBAL.
82 *> 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
83 *> \endverbatim
84 *>
85 *> \param[in] LSCALE
86 *> \verbatim
87 *> LSCALE is REAL array, dimension (N)
88 *> Details of the permutations and/or scaling factors applied
89 *> to the left side of A and B, as returned by CGGBAL.
90 *> \endverbatim
91 *>
92 *> \param[in] RSCALE
93 *> \verbatim
94 *> RSCALE is REAL array, dimension (N)
95 *> Details of the permutations and/or scaling factors applied
96 *> to the right side of A and B, as returned by CGGBAL.
97 *> \endverbatim
98 *>
99 *> \param[in] M
100 *> \verbatim
101 *> M is INTEGER
102 *> The number of columns of the matrix V. M >= 0.
103 *> \endverbatim
104 *>
105 *> \param[in,out] V
106 *> \verbatim
107 *> V is COMPLEX array, dimension (LDV,M)
108 *> On entry, the matrix of right or left eigenvectors to be
109 *> transformed, as returned by CTGEVC.
110 *> On exit, V is overwritten by the transformed eigenvectors.
111 *> \endverbatim
112 *>
113 *> \param[in] LDV
114 *> \verbatim
115 *> LDV is INTEGER
116 *> The leading dimension of the matrix V. LDV >= max(1,N).
117 *> \endverbatim
118 *>
119 *> \param[out] INFO
120 *> \verbatim
121 *> INFO is INTEGER
122 *> = 0: successful exit.
123 *> < 0: if INFO = -i, the i-th argument had an illegal value.
124 *> \endverbatim
125 *
126 * Authors:
127 * ========
128 *
129 *> \author Univ. of Tennessee
130 *> \author Univ. of California Berkeley
131 *> \author Univ. of Colorado Denver
132 *> \author NAG Ltd.
133 *
134 *> \date November 2011
135 *
136 *> \ingroup complexGBcomputational
137 *
138 *> \par Further Details:
139 * =====================
140 *>
141 *> \verbatim
142 *>
143 *> See R.C. Ward, Balancing the generalized eigenvalue problem,
144 *> SIAM J. Sci. Stat. Comp. 2 (1981), 141-152.
145 *> \endverbatim
146 *>
147 * =====================================================================
148  SUBROUTINE cggbak( JOB, SIDE, N, ILO, IHI, LSCALE, RSCALE, M, V,
149  $ ldv, info )
150 *
151 * -- LAPACK computational routine (version 3.4.0) --
152 * -- LAPACK is a software package provided by Univ. of Tennessee, --
153 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
154 * November 2011
155 *
156 * .. Scalar Arguments ..
157  CHARACTER JOB, SIDE
158  INTEGER IHI, ILO, INFO, LDV, M, N
159 * ..
160 * .. Array Arguments ..
161  REAL LSCALE( * ), RSCALE( * )
162  COMPLEX V( ldv, * )
163 * ..
164 *
165 * =====================================================================
166 *
167 * .. Local Scalars ..
168  LOGICAL LEFTV, RIGHTV
169  INTEGER I, K
170 * ..
171 * .. External Functions ..
172  LOGICAL LSAME
173  EXTERNAL lsame
174 * ..
175 * .. External Subroutines ..
176  EXTERNAL csscal, cswap, xerbla
177 * ..
178 * .. Intrinsic Functions ..
179  INTRINSIC max
180 * ..
181 * .. Executable Statements ..
182 *
183 * Test the input parameters
184 *
185  rightv = lsame( side, 'R' )
186  leftv = lsame( side, 'L' )
187 *
188  info = 0
189  IF( .NOT.lsame( job, 'N' ) .AND. .NOT.lsame( job, 'P' ) .AND.
190  $ .NOT.lsame( job, 'S' ) .AND. .NOT.lsame( job, 'B' ) ) THEN
191  info = -1
192  ELSE IF( .NOT.rightv .AND. .NOT.leftv ) THEN
193  info = -2
194  ELSE IF( n.LT.0 ) THEN
195  info = -3
196  ELSE IF( ilo.LT.1 ) THEN
197  info = -4
198  ELSE IF( n.EQ.0 .AND. ihi.EQ.0 .AND. ilo.NE.1 ) THEN
199  info = -4
200  ELSE IF( n.GT.0 .AND. ( ihi.LT.ilo .OR. ihi.GT.max( 1, n ) ) )
201  $ THEN
202  info = -5
203  ELSE IF( n.EQ.0 .AND. ilo.EQ.1 .AND. ihi.NE.0 ) THEN
204  info = -5
205  ELSE IF( m.LT.0 ) THEN
206  info = -8
207  ELSE IF( ldv.LT.max( 1, n ) ) THEN
208  info = -10
209  END IF
210  IF( info.NE.0 ) THEN
211  CALL xerbla( 'CGGBAK', -info )
212  RETURN
213  END IF
214 *
215 * Quick return if possible
216 *
217  IF( n.EQ.0 )
218  $ RETURN
219  IF( m.EQ.0 )
220  $ RETURN
221  IF( lsame( job, 'N' ) )
222  $ RETURN
223 *
224  IF( ilo.EQ.ihi )
225  $ GO TO 30
226 *
227 * Backward balance
228 *
229  IF( lsame( job, 'S' ) .OR. lsame( job, 'B' ) ) THEN
230 *
231 * Backward transformation on right eigenvectors
232 *
233  IF( rightv ) THEN
234  DO 10 i = ilo, ihi
235  CALL csscal( m, rscale( i ), v( i, 1 ), ldv )
236  10 CONTINUE
237  END IF
238 *
239 * Backward transformation on left eigenvectors
240 *
241  IF( leftv ) THEN
242  DO 20 i = ilo, ihi
243  CALL csscal( m, lscale( i ), v( i, 1 ), ldv )
244  20 CONTINUE
245  END IF
246  END IF
247 *
248 * Backward permutation
249 *
250  30 CONTINUE
251  IF( lsame( job, 'P' ) .OR. lsame( job, 'B' ) ) THEN
252 *
253 * Backward permutation on right eigenvectors
254 *
255  IF( rightv ) THEN
256  IF( ilo.EQ.1 )
257  $ GO TO 50
258  DO 40 i = ilo - 1, 1, -1
259  k = rscale( i )
260  IF( k.EQ.i )
261  $ GO TO 40
262  CALL cswap( m, v( i, 1 ), ldv, v( k, 1 ), ldv )
263  40 CONTINUE
264 *
265  50 CONTINUE
266  IF( ihi.EQ.n )
267  $ GO TO 70
268  DO 60 i = ihi + 1, n
269  k = rscale( i )
270  IF( k.EQ.i )
271  $ GO TO 60
272  CALL cswap( m, v( i, 1 ), ldv, v( k, 1 ), ldv )
273  60 CONTINUE
274  END IF
275 *
276 * Backward permutation on left eigenvectors
277 *
278  70 CONTINUE
279  IF( leftv ) THEN
280  IF( ilo.EQ.1 )
281  $ GO TO 90
282  DO 80 i = ilo - 1, 1, -1
283  k = lscale( i )
284  IF( k.EQ.i )
285  $ GO TO 80
286  CALL cswap( m, v( i, 1 ), ldv, v( k, 1 ), ldv )
287  80 CONTINUE
288 *
289  90 CONTINUE
290  IF( ihi.EQ.n )
291  $ GO TO 110
292  DO 100 i = ihi + 1, n
293  k = lscale( i )
294  IF( k.EQ.i )
295  $ GO TO 100
296  CALL cswap( m, v( i, 1 ), ldv, v( k, 1 ), ldv )
297  100 CONTINUE
298  END IF
299  END IF
300 *
301  110 CONTINUE
302 *
303  RETURN
304 *
305 * End of CGGBAK
306 *
307  END
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
subroutine cggbak(JOB, SIDE, N, ILO, IHI, LSCALE, RSCALE, M, V, LDV, INFO)
CGGBAK
Definition: cggbak.f:150
subroutine cswap(N, CX, INCX, CY, INCY)
CSWAP
Definition: cswap.f:52
subroutine csscal(N, SA, CX, INCX)
CSSCAL
Definition: csscal.f:54