LAPACK 3.11.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
cgeev.f
Go to the documentation of this file.
1*> \brief <b> CGEEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices</b>
2*
3* =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6* http://www.netlib.org/lapack/explore-html/
7*
8*> \htmlonly
9*> Download CGEEV + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cgeev.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/cgeev.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cgeev.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18* Definition:
19* ===========
20*
21* SUBROUTINE CGEEV( JOBVL, JOBVR, N, A, LDA, W, VL, LDVL, VR, LDVR,
22* WORK, LWORK, RWORK, INFO )
23*
24* .. Scalar Arguments ..
25* CHARACTER JOBVL, JOBVR
26* INTEGER INFO, LDA, LDVL, LDVR, LWORK, N
27* ..
28* .. Array Arguments ..
29* REAL RWORK( * )
30* COMPLEX A( LDA, * ), VL( LDVL, * ), VR( LDVR, * ),
31* $ W( * ), WORK( * )
32* ..
33*
34*
35*> \par Purpose:
36* =============
37*>
38*> \verbatim
39*>
40*> CGEEV computes for an N-by-N complex nonsymmetric matrix A, the
41*> eigenvalues and, optionally, the left and/or right eigenvectors.
42*>
43*> The right eigenvector v(j) of A satisfies
44*> A * v(j) = lambda(j) * v(j)
45*> where lambda(j) is its eigenvalue.
46*> The left eigenvector u(j) of A satisfies
47*> u(j)**H * A = lambda(j) * u(j)**H
48*> where u(j)**H denotes the conjugate transpose of u(j).
49*>
50*> The computed eigenvectors are normalized to have Euclidean norm
51*> equal to 1 and largest component real.
52*> \endverbatim
53*
54* Arguments:
55* ==========
56*
57*> \param[in] JOBVL
58*> \verbatim
59*> JOBVL is CHARACTER*1
60*> = 'N': left eigenvectors of A are not computed;
61*> = 'V': left eigenvectors of are computed.
62*> \endverbatim
63*>
64*> \param[in] JOBVR
65*> \verbatim
66*> JOBVR is CHARACTER*1
67*> = 'N': right eigenvectors of A are not computed;
68*> = 'V': right eigenvectors of A are computed.
69*> \endverbatim
70*>
71*> \param[in] N
72*> \verbatim
73*> N is INTEGER
74*> The order of the matrix A. N >= 0.
75*> \endverbatim
76*>
77*> \param[in,out] A
78*> \verbatim
79*> A is COMPLEX array, dimension (LDA,N)
80*> On entry, the N-by-N matrix A.
81*> On exit, A has been overwritten.
82*> \endverbatim
83*>
84*> \param[in] LDA
85*> \verbatim
86*> LDA is INTEGER
87*> The leading dimension of the array A. LDA >= max(1,N).
88*> \endverbatim
89*>
90*> \param[out] W
91*> \verbatim
92*> W is COMPLEX array, dimension (N)
93*> W contains the computed eigenvalues.
94*> \endverbatim
95*>
96*> \param[out] VL
97*> \verbatim
98*> VL is COMPLEX array, dimension (LDVL,N)
99*> If JOBVL = 'V', the left eigenvectors u(j) are stored one
100*> after another in the columns of VL, in the same order
101*> as their eigenvalues.
102*> If JOBVL = 'N', VL is not referenced.
103*> u(j) = VL(:,j), the j-th column of VL.
104*> \endverbatim
105*>
106*> \param[in] LDVL
107*> \verbatim
108*> LDVL is INTEGER
109*> The leading dimension of the array VL. LDVL >= 1; if
110*> JOBVL = 'V', LDVL >= N.
111*> \endverbatim
112*>
113*> \param[out] VR
114*> \verbatim
115*> VR is COMPLEX array, dimension (LDVR,N)
116*> If JOBVR = 'V', the right eigenvectors v(j) are stored one
117*> after another in the columns of VR, in the same order
118*> as their eigenvalues.
119*> If JOBVR = 'N', VR is not referenced.
120*> v(j) = VR(:,j), the j-th column of VR.
121*> \endverbatim
122*>
123*> \param[in] LDVR
124*> \verbatim
125*> LDVR is INTEGER
126*> The leading dimension of the array VR. LDVR >= 1; if
127*> JOBVR = 'V', LDVR >= N.
128*> \endverbatim
129*>
130*> \param[out] WORK
131*> \verbatim
132*> WORK is COMPLEX array, dimension (MAX(1,LWORK))
133*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
134*> \endverbatim
135*>
136*> \param[in] LWORK
137*> \verbatim
138*> LWORK is INTEGER
139*> The dimension of the array WORK. LWORK >= max(1,2*N).
140*> For good performance, LWORK must generally be larger.
141*>
142*> If LWORK = -1, then a workspace query is assumed; the routine
143*> only calculates the optimal size of the WORK array, returns
144*> this value as the first entry of the WORK array, and no error
145*> message related to LWORK is issued by XERBLA.
146*> \endverbatim
147*>
148*> \param[out] RWORK
149*> \verbatim
150*> RWORK is REAL array, dimension (2*N)
151*> \endverbatim
152*>
153*> \param[out] INFO
154*> \verbatim
155*> INFO is INTEGER
156*> = 0: successful exit
157*> < 0: if INFO = -i, the i-th argument had an illegal value.
158*> > 0: if INFO = i, the QR algorithm failed to compute all the
159*> eigenvalues, and no eigenvectors have been computed;
160*> elements i+1:N of W contain eigenvalues which have
161*> converged.
162*> \endverbatim
163*
164* Authors:
165* ========
166*
167*> \author Univ. of Tennessee
168*> \author Univ. of California Berkeley
169*> \author Univ. of Colorado Denver
170*> \author NAG Ltd.
171*
172*
173* @generated from zgeev.f, fortran z -> c, Tue Apr 19 01:47:44 2016
174*
175*> \ingroup complexGEeigen
176*
177* =====================================================================
178 SUBROUTINE cgeev( JOBVL, JOBVR, N, A, LDA, W, VL, LDVL, VR, LDVR,
179 $ WORK, LWORK, RWORK, INFO )
180 implicit none
181*
182* -- LAPACK driver routine --
183* -- LAPACK is a software package provided by Univ. of Tennessee, --
184* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
185*
186* .. Scalar Arguments ..
187 CHARACTER JOBVL, JOBVR
188 INTEGER INFO, LDA, LDVL, LDVR, LWORK, N
189* ..
190* .. Array Arguments ..
191 REAL RWORK( * )
192 COMPLEX A( LDA, * ), VL( LDVL, * ), VR( LDVR, * ),
193 $ w( * ), work( * )
194* ..
195*
196* =====================================================================
197*
198* .. Parameters ..
199 REAL ZERO, ONE
200 parameter( zero = 0.0e0, one = 1.0e0 )
201* ..
202* .. Local Scalars ..
203 LOGICAL LQUERY, SCALEA, WANTVL, WANTVR
204 CHARACTER SIDE
205 INTEGER HSWORK, I, IBAL, IERR, IHI, ILO, IRWORK, ITAU,
206 $ iwrk, k, lwork_trevc, maxwrk, minwrk, nout
207 REAL ANRM, BIGNUM, CSCALE, EPS, SCL, SMLNUM
208 COMPLEX TMP
209* ..
210* .. Local Arrays ..
211 LOGICAL SELECT( 1 )
212 REAL DUM( 1 )
213* ..
214* .. External Subroutines ..
215 EXTERNAL slabad, xerbla, csscal, cgebak, cgebal, cgehrd,
217* ..
218* .. External Functions ..
219 LOGICAL LSAME
220 INTEGER ISAMAX, ILAENV
221 REAL SLAMCH, SCNRM2, CLANGE
222 EXTERNAL lsame, isamax, ilaenv, slamch, scnrm2, clange
223* ..
224* .. Intrinsic Functions ..
225 INTRINSIC real, cmplx, conjg, aimag, max, sqrt
226* ..
227* .. Executable Statements ..
228*
229* Test the input arguments
230*
231 info = 0
232 lquery = ( lwork.EQ.-1 )
233 wantvl = lsame( jobvl, 'V' )
234 wantvr = lsame( jobvr, 'V' )
235 IF( ( .NOT.wantvl ) .AND. ( .NOT.lsame( jobvl, 'N' ) ) ) THEN
236 info = -1
237 ELSE IF( ( .NOT.wantvr ) .AND. ( .NOT.lsame( jobvr, 'N' ) ) ) THEN
238 info = -2
239 ELSE IF( n.LT.0 ) THEN
240 info = -3
241 ELSE IF( lda.LT.max( 1, n ) ) THEN
242 info = -5
243 ELSE IF( ldvl.LT.1 .OR. ( wantvl .AND. ldvl.LT.n ) ) THEN
244 info = -8
245 ELSE IF( ldvr.LT.1 .OR. ( wantvr .AND. ldvr.LT.n ) ) THEN
246 info = -10
247 END IF
248*
249* Compute workspace
250* (Note: Comments in the code beginning "Workspace:" describe the
251* minimal amount of workspace needed at that point in the code,
252* as well as the preferred amount for good performance.
253* CWorkspace refers to complex workspace, and RWorkspace to real
254* workspace. NB refers to the optimal block size for the
255* immediately following subroutine, as returned by ILAENV.
256* HSWORK refers to the workspace preferred by CHSEQR, as
257* calculated below. HSWORK is computed assuming ILO=1 and IHI=N,
258* the worst case.)
259*
260 IF( info.EQ.0 ) THEN
261 IF( n.EQ.0 ) THEN
262 minwrk = 1
263 maxwrk = 1
264 ELSE
265 maxwrk = n + n*ilaenv( 1, 'CGEHRD', ' ', n, 1, n, 0 )
266 minwrk = 2*n
267 IF( wantvl ) THEN
268 maxwrk = max( maxwrk, n + ( n - 1 )*ilaenv( 1, 'CUNGHR',
269 $ ' ', n, 1, n, -1 ) )
270 CALL ctrevc3( 'L', 'B', SELECT, n, a, lda,
271 $ vl, ldvl, vr, ldvr,
272 $ n, nout, work, -1, rwork, -1, ierr )
273 lwork_trevc = int( work(1) )
274 maxwrk = max( maxwrk, n + lwork_trevc )
275 CALL chseqr( 'S', 'V', n, 1, n, a, lda, w, vl, ldvl,
276 $ work, -1, info )
277 ELSE IF( wantvr ) THEN
278 maxwrk = max( maxwrk, n + ( n - 1 )*ilaenv( 1, 'CUNGHR',
279 $ ' ', n, 1, n, -1 ) )
280 CALL ctrevc3( 'R', 'B', SELECT, n, a, lda,
281 $ vl, ldvl, vr, ldvr,
282 $ n, nout, work, -1, rwork, -1, ierr )
283 lwork_trevc = int( work(1) )
284 maxwrk = max( maxwrk, n + lwork_trevc )
285 CALL chseqr( 'S', 'V', n, 1, n, a, lda, w, vr, ldvr,
286 $ work, -1, info )
287 ELSE
288 CALL chseqr( 'E', 'N', n, 1, n, a, lda, w, vr, ldvr,
289 $ work, -1, info )
290 END IF
291 hswork = int( work(1) )
292 maxwrk = max( maxwrk, hswork, minwrk )
293 END IF
294 work( 1 ) = maxwrk
295*
296 IF( lwork.LT.minwrk .AND. .NOT.lquery ) THEN
297 info = -12
298 END IF
299 END IF
300*
301 IF( info.NE.0 ) THEN
302 CALL xerbla( 'CGEEV ', -info )
303 RETURN
304 ELSE IF( lquery ) THEN
305 RETURN
306 END IF
307*
308* Quick return if possible
309*
310 IF( n.EQ.0 )
311 $ RETURN
312*
313* Get machine constants
314*
315 eps = slamch( 'P' )
316 smlnum = slamch( 'S' )
317 bignum = one / smlnum
318 CALL slabad( smlnum, bignum )
319 smlnum = sqrt( smlnum ) / eps
320 bignum = one / smlnum
321*
322* Scale A if max element outside range [SMLNUM,BIGNUM]
323*
324 anrm = clange( 'M', n, n, a, lda, dum )
325 scalea = .false.
326 IF( anrm.GT.zero .AND. anrm.LT.smlnum ) THEN
327 scalea = .true.
328 cscale = smlnum
329 ELSE IF( anrm.GT.bignum ) THEN
330 scalea = .true.
331 cscale = bignum
332 END IF
333 IF( scalea )
334 $ CALL clascl( 'G', 0, 0, anrm, cscale, n, n, a, lda, ierr )
335*
336* Balance the matrix
337* (CWorkspace: none)
338* (RWorkspace: need N)
339*
340 ibal = 1
341 CALL cgebal( 'B', n, a, lda, ilo, ihi, rwork( ibal ), ierr )
342*
343* Reduce to upper Hessenberg form
344* (CWorkspace: need 2*N, prefer N+N*NB)
345* (RWorkspace: none)
346*
347 itau = 1
348 iwrk = itau + n
349 CALL cgehrd( n, ilo, ihi, a, lda, work( itau ), work( iwrk ),
350 $ lwork-iwrk+1, ierr )
351*
352 IF( wantvl ) THEN
353*
354* Want left eigenvectors
355* Copy Householder vectors to VL
356*
357 side = 'L'
358 CALL clacpy( 'L', n, n, a, lda, vl, ldvl )
359*
360* Generate unitary matrix in VL
361* (CWorkspace: need 2*N-1, prefer N+(N-1)*NB)
362* (RWorkspace: none)
363*
364 CALL cunghr( n, ilo, ihi, vl, ldvl, work( itau ), work( iwrk ),
365 $ lwork-iwrk+1, ierr )
366*
367* Perform QR iteration, accumulating Schur vectors in VL
368* (CWorkspace: need 1, prefer HSWORK (see comments) )
369* (RWorkspace: none)
370*
371 iwrk = itau
372 CALL chseqr( 'S', 'V', n, ilo, ihi, a, lda, w, vl, ldvl,
373 $ work( iwrk ), lwork-iwrk+1, info )
374*
375 IF( wantvr ) THEN
376*
377* Want left and right eigenvectors
378* Copy Schur vectors to VR
379*
380 side = 'B'
381 CALL clacpy( 'F', n, n, vl, ldvl, vr, ldvr )
382 END IF
383*
384 ELSE IF( wantvr ) THEN
385*
386* Want right eigenvectors
387* Copy Householder vectors to VR
388*
389 side = 'R'
390 CALL clacpy( 'L', n, n, a, lda, vr, ldvr )
391*
392* Generate unitary matrix in VR
393* (CWorkspace: need 2*N-1, prefer N+(N-1)*NB)
394* (RWorkspace: none)
395*
396 CALL cunghr( n, ilo, ihi, vr, ldvr, work( itau ), work( iwrk ),
397 $ lwork-iwrk+1, ierr )
398*
399* Perform QR iteration, accumulating Schur vectors in VR
400* (CWorkspace: need 1, prefer HSWORK (see comments) )
401* (RWorkspace: none)
402*
403 iwrk = itau
404 CALL chseqr( 'S', 'V', n, ilo, ihi, a, lda, w, vr, ldvr,
405 $ work( iwrk ), lwork-iwrk+1, info )
406*
407 ELSE
408*
409* Compute eigenvalues only
410* (CWorkspace: need 1, prefer HSWORK (see comments) )
411* (RWorkspace: none)
412*
413 iwrk = itau
414 CALL chseqr( 'E', 'N', n, ilo, ihi, a, lda, w, vr, ldvr,
415 $ work( iwrk ), lwork-iwrk+1, info )
416 END IF
417*
418* If INFO .NE. 0 from CHSEQR, then quit
419*
420 IF( info.NE.0 )
421 $ GO TO 50
422*
423 IF( wantvl .OR. wantvr ) THEN
424*
425* Compute left and/or right eigenvectors
426* (CWorkspace: need 2*N, prefer N + 2*N*NB)
427* (RWorkspace: need 2*N)
428*
429 irwork = ibal + n
430 CALL ctrevc3( side, 'B', SELECT, n, a, lda, vl, ldvl, vr, ldvr,
431 $ n, nout, work( iwrk ), lwork-iwrk+1,
432 $ rwork( irwork ), n, ierr )
433 END IF
434*
435 IF( wantvl ) THEN
436*
437* Undo balancing of left eigenvectors
438* (CWorkspace: none)
439* (RWorkspace: need N)
440*
441 CALL cgebak( 'B', 'L', n, ilo, ihi, rwork( ibal ), n, vl, ldvl,
442 $ ierr )
443*
444* Normalize left eigenvectors and make largest component real
445*
446 DO 20 i = 1, n
447 scl = one / scnrm2( n, vl( 1, i ), 1 )
448 CALL csscal( n, scl, vl( 1, i ), 1 )
449 DO 10 k = 1, n
450 rwork( irwork+k-1 ) = real( vl( k, i ) )**2 +
451 $ aimag( vl( k, i ) )**2
452 10 CONTINUE
453 k = isamax( n, rwork( irwork ), 1 )
454 tmp = conjg( vl( k, i ) ) / sqrt( rwork( irwork+k-1 ) )
455 CALL cscal( n, tmp, vl( 1, i ), 1 )
456 vl( k, i ) = cmplx( real( vl( k, i ) ), zero )
457 20 CONTINUE
458 END IF
459*
460 IF( wantvr ) THEN
461*
462* Undo balancing of right eigenvectors
463* (CWorkspace: none)
464* (RWorkspace: need N)
465*
466 CALL cgebak( 'B', 'R', n, ilo, ihi, rwork( ibal ), n, vr, ldvr,
467 $ ierr )
468*
469* Normalize right eigenvectors and make largest component real
470*
471 DO 40 i = 1, n
472 scl = one / scnrm2( n, vr( 1, i ), 1 )
473 CALL csscal( n, scl, vr( 1, i ), 1 )
474 DO 30 k = 1, n
475 rwork( irwork+k-1 ) = real( vr( k, i ) )**2 +
476 $ aimag( vr( k, i ) )**2
477 30 CONTINUE
478 k = isamax( n, rwork( irwork ), 1 )
479 tmp = conjg( vr( k, i ) ) / sqrt( rwork( irwork+k-1 ) )
480 CALL cscal( n, tmp, vr( 1, i ), 1 )
481 vr( k, i ) = cmplx( real( vr( k, i ) ), zero )
482 40 CONTINUE
483 END IF
484*
485* Undo scaling if necessary
486*
487 50 CONTINUE
488 IF( scalea ) THEN
489 CALL clascl( 'G', 0, 0, cscale, anrm, n-info, 1, w( info+1 ),
490 $ max( n-info, 1 ), ierr )
491 IF( info.GT.0 ) THEN
492 CALL clascl( 'G', 0, 0, cscale, anrm, ilo-1, 1, w, n, ierr )
493 END IF
494 END IF
495*
496 work( 1 ) = maxwrk
497 RETURN
498*
499* End of CGEEV
500*
501 END
subroutine slabad(SMALL, LARGE)
SLABAD
Definition: slabad.f:74
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:60
subroutine csscal(N, SA, CX, INCX)
CSSCAL
Definition: csscal.f:78
subroutine cscal(N, CA, CX, INCX)
CSCAL
Definition: cscal.f:78
subroutine cgehrd(N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO)
CGEHRD
Definition: cgehrd.f:167
subroutine cgebal(JOB, N, A, LDA, ILO, IHI, SCALE, INFO)
CGEBAL
Definition: cgebal.f:161
subroutine cgebak(JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV, INFO)
CGEBAK
Definition: cgebak.f:131
subroutine cgeev(JOBVL, JOBVR, N, A, LDA, W, VL, LDVL, VR, LDVR, WORK, LWORK, RWORK, INFO)
CGEEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices
Definition: cgeev.f:180
subroutine clascl(TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO)
CLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.
Definition: clascl.f:143
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
Definition: clacpy.f:103
subroutine ctrevc3(SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, LDVR, MM, M, WORK, LWORK, RWORK, LRWORK, INFO)
CTREVC3
Definition: ctrevc3.f:244
subroutine cunghr(N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO)
CUNGHR
Definition: cunghr.f:126
subroutine chseqr(JOB, COMPZ, N, ILO, IHI, H, LDH, W, Z, LDZ, WORK, LWORK, INFO)
CHSEQR
Definition: chseqr.f:299