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