LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
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*> \ingroup gebak
127*
128* =====================================================================
129 SUBROUTINE cgebak( JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV,
130 $ INFO )
131*
132* -- LAPACK computational routine --
133* -- LAPACK is a software package provided by Univ. of Tennessee, --
134* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
135*
136* .. Scalar Arguments ..
137 CHARACTER JOB, SIDE
138 INTEGER IHI, ILO, INFO, LDV, M, N
139* ..
140* .. Array Arguments ..
141 REAL SCALE( * )
142 COMPLEX V( LDV, * )
143* ..
144*
145* =====================================================================
146*
147* .. Parameters ..
148 REAL ONE
149 parameter( one = 1.0e+0 )
150* ..
151* .. Local Scalars ..
152 LOGICAL LEFTV, RIGHTV
153 INTEGER I, II, K
154 REAL S
155* ..
156* .. External Functions ..
157 LOGICAL LSAME
158 EXTERNAL lsame
159* ..
160* .. External Subroutines ..
161 EXTERNAL csscal, cswap, xerbla
162* ..
163* .. Intrinsic Functions ..
164 INTRINSIC max, min
165* ..
166* .. Executable Statements ..
167*
168* Decode and Test the input parameters
169*
170 rightv = lsame( side, 'R' )
171 leftv = lsame( side, 'L' )
172*
173 info = 0
174 IF( .NOT.lsame( job, 'N' ) .AND. .NOT.lsame( job, 'P' ) .AND.
175 $ .NOT.lsame( job, 'S' ) .AND. .NOT.lsame( job, 'B' ) ) THEN
176 info = -1
177 ELSE IF( .NOT.rightv .AND. .NOT.leftv ) THEN
178 info = -2
179 ELSE IF( n.LT.0 ) THEN
180 info = -3
181 ELSE IF( ilo.LT.1 .OR. ilo.GT.max( 1, n ) ) THEN
182 info = -4
183 ELSE IF( ihi.LT.min( ilo, n ) .OR. ihi.GT.n ) THEN
184 info = -5
185 ELSE IF( m.LT.0 ) THEN
186 info = -7
187 ELSE IF( ldv.LT.max( 1, n ) ) THEN
188 info = -9
189 END IF
190 IF( info.NE.0 ) THEN
191 CALL xerbla( 'CGEBAK', -info )
192 RETURN
193 END IF
194*
195* Quick return if possible
196*
197 IF( n.EQ.0 )
198 $ RETURN
199 IF( m.EQ.0 )
200 $ RETURN
201 IF( lsame( job, 'N' ) )
202 $ RETURN
203*
204 IF( ilo.EQ.ihi )
205 $ GO TO 30
206*
207* Backward balance
208*
209 IF( lsame( job, 'S' ) .OR. lsame( job, 'B' ) ) THEN
210*
211 IF( rightv ) THEN
212 DO 10 i = ilo, ihi
213 s = scale( i )
214 CALL csscal( m, s, v( i, 1 ), ldv )
215 10 CONTINUE
216 END IF
217*
218 IF( leftv ) THEN
219 DO 20 i = ilo, ihi
220 s = one / scale( i )
221 CALL csscal( m, s, v( i, 1 ), ldv )
222 20 CONTINUE
223 END IF
224*
225 END IF
226*
227* Backward permutation
228*
229* For I = ILO-1 step -1 until 1,
230* IHI+1 step 1 until N do --
231*
232 30 CONTINUE
233 IF( lsame( job, 'P' ) .OR. lsame( job, 'B' ) ) THEN
234 IF( rightv ) THEN
235 DO 40 ii = 1, n
236 i = ii
237 IF( i.GE.ilo .AND. i.LE.ihi )
238 $ GO TO 40
239 IF( i.LT.ilo )
240 $ i = ilo - ii
241 k = int( scale( i ) )
242 IF( k.EQ.i )
243 $ GO TO 40
244 CALL cswap( m, v( i, 1 ), ldv, v( k, 1 ), ldv )
245 40 CONTINUE
246 END IF
247*
248 IF( leftv ) THEN
249 DO 50 ii = 1, n
250 i = ii
251 IF( i.GE.ilo .AND. i.LE.ihi )
252 $ GO TO 50
253 IF( i.LT.ilo )
254 $ i = ilo - ii
255 k = int( scale( i ) )
256 IF( k.EQ.i )
257 $ GO TO 50
258 CALL cswap( m, v( i, 1 ), ldv, v( k, 1 ), ldv )
259 50 CONTINUE
260 END IF
261 END IF
262*
263 RETURN
264*
265* End of CGEBAK
266*
267 END
subroutine xerbla(srname, info)
Definition cblat2.f:3285
subroutine cgebak(job, side, n, ilo, ihi, scale, m, v, ldv, info)
CGEBAK
Definition cgebak.f:131
subroutine csscal(n, sa, cx, incx)
CSSCAL
Definition csscal.f:78
subroutine cswap(n, cx, incx, cy, incy)
CSWAP
Definition cswap.f:81