177 SUBROUTINE cgeev( JOBVL, JOBVR, N, A, LDA, W, VL, LDVL, VR, LDVR,
178 $ work, lwork, rwork, info )
186 CHARACTER jobvl, jobvr
187 INTEGER info, lda, ldvl, ldvr, lwork, n
191 COMPLEX a( lda, * ), vl( ldvl, * ), vr( ldvr, * ),
199 parameter( zero = 0.0e0, one = 1.0e0 )
202 LOGICAL lquery, scalea, wantvl, wantvr
204 INTEGER hswork, i, ibal, ierr, ihi, ilo, irwork, itau,
205 $ iwrk, k, maxwrk, minwrk, nout
206 REAL anrm, bignum, cscale, eps, scl, smlnum
224 INTRINSIC aimag, cmplx, conjg, max,
REAL, sqrt
231 lquery = ( lwork.EQ.-1 )
232 wantvl =
lsame( jobvl,
'V' )
233 wantvr =
lsame( jobvr,
'V' )
234 IF( ( .NOT.wantvl ) .AND. ( .NOT.
lsame( jobvl,
'N' ) ) )
THEN
236 ELSE IF( ( .NOT.wantvr ) .AND. ( .NOT.
lsame( jobvr,
'N' ) ) )
THEN
238 ELSE IF( n.LT.0 )
THEN
240 ELSE IF( lda.LT.max( 1, n ) )
THEN
242 ELSE IF( ldvl.LT.1 .OR. ( wantvl .AND. ldvl.LT.n ) )
THEN
244 ELSE IF( ldvr.LT.1 .OR. ( wantvr .AND. ldvr.LT.n ) )
THEN
265 maxwrk = n + n*
ilaenv( 1,
'CGEHRD',
' ', n, 1, n, 0 )
268 maxwrk = max( maxwrk, n + ( n - 1 )*
ilaenv( 1,
'CUNGHR',
269 $
' ', n, 1, n, -1 ) )
270 CALL
chseqr(
'S',
'V', n, 1, n, a, lda, w, vl, ldvl,
272 ELSE IF( wantvr )
THEN
273 maxwrk = max( maxwrk, n + ( n - 1 )*
ilaenv( 1,
'CUNGHR',
274 $
' ', n, 1, n, -1 ) )
275 CALL
chseqr(
'S',
'V', n, 1, n, a, lda, w, vr, ldvr,
278 CALL
chseqr(
'E',
'N', n, 1, n, a, lda, w, vr, ldvr,
282 maxwrk = max( maxwrk, hswork, minwrk )
286 IF( lwork.LT.minwrk .AND. .NOT.lquery )
THEN
292 CALL
xerbla(
'CGEEV ', -info )
294 ELSE IF( lquery )
THEN
307 bignum = one / smlnum
308 CALL
slabad( smlnum, bignum )
309 smlnum = sqrt( smlnum ) / eps
310 bignum = one / smlnum
314 anrm =
clange(
'M', n, n, a, lda, dum )
316 IF( anrm.GT.zero .AND. anrm.LT.smlnum )
THEN
319 ELSE IF( anrm.GT.bignum )
THEN
324 $ CALL
clascl(
'G', 0, 0, anrm, cscale, n, n, a, lda, ierr )
331 CALL
cgebal(
'B', n, a, lda, ilo, ihi, rwork( ibal ), ierr )
339 CALL
cgehrd( n, ilo, ihi, a, lda, work( itau ), work( iwrk ),
340 $ lwork-iwrk+1, ierr )
348 CALL
clacpy(
'L', n, n, a, lda, vl, ldvl )
354 CALL
cunghr( n, ilo, ihi, vl, ldvl, work( itau ), work( iwrk ),
355 $ lwork-iwrk+1, ierr )
362 CALL
chseqr(
'S',
'V', n, ilo, ihi, a, lda, w, vl, ldvl,
363 $ work( iwrk ), lwork-iwrk+1, info )
371 CALL
clacpy(
'F', n, n, vl, ldvl, vr, ldvr )
374 ELSE IF( wantvr )
THEN
380 CALL
clacpy(
'L', n, n, a, lda, vr, ldvr )
386 CALL
cunghr( n, ilo, ihi, vr, ldvr, work( itau ), work( iwrk ),
387 $ lwork-iwrk+1, ierr )
394 CALL
chseqr(
'S',
'V', n, ilo, ihi, a, lda, w, vr, ldvr,
395 $ work( iwrk ), lwork-iwrk+1, info )
404 CALL
chseqr(
'E',
'N', n, ilo, ihi, a, lda, w, vr, ldvr,
405 $ work( iwrk ), lwork-iwrk+1, info )
413 IF( wantvl .OR. wantvr )
THEN
420 CALL
ctrevc( side,
'B',
SELECT, n, a, lda, vl, ldvl, vr, ldvr,
421 $ n, nout, work( iwrk ), rwork( irwork ), ierr )
430 CALL
cgebak(
'B',
'L', n, ilo, ihi, rwork( ibal ), n, vl, ldvl,
436 scl = one /
scnrm2( n, vl( 1, i ), 1 )
437 CALL
csscal( n, scl, vl( 1, i ), 1 )
439 rwork( irwork+k-1 ) =
REAL( VL( K, I ) )**2 +
440 $ aimag( vl( k, i ) )**2
442 k =
isamax( n, rwork( irwork ), 1 )
443 tmp = conjg( vl( k, i ) ) / sqrt( rwork( irwork+k-1 ) )
444 CALL
cscal( n, tmp, vl( 1, i ), 1 )
445 vl( k, i ) = cmplx(
REAL( VL( K, I ) ), zero )
455 CALL
cgebak(
'B',
'R', n, ilo, ihi, rwork( ibal ), n, vr, ldvr,
461 scl = one /
scnrm2( n, vr( 1, i ), 1 )
462 CALL
csscal( n, scl, vr( 1, i ), 1 )
464 rwork( irwork+k-1 ) =
REAL( VR( K, I ) )**2 +
465 $ aimag( vr( k, i ) )**2
467 k =
isamax( n, rwork( irwork ), 1 )
468 tmp = conjg( vr( k, i ) ) / sqrt( rwork( irwork+k-1 ) )
469 CALL
cscal( n, tmp, vr( 1, i ), 1 )
470 vr( k, i ) = cmplx(
REAL( VR( K, I ) ), zero )
478 CALL
clascl(
'G', 0, 0, cscale, anrm, n-info, 1, w( info+1 ),
479 $ max( n-info, 1 ), ierr )
481 CALL
clascl(
'G', 0, 0, cscale, anrm, ilo-1, 1, w, n, ierr )
real function clange(NORM, M, N, A, LDA, WORK)
CLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
subroutine cscal(N, CA, CX, INCX)
CSCAL
integer function isamax(N, SX, INCX)
ISAMAX
subroutine xerbla(SRNAME, INFO)
XERBLA
logical function lsame(CA, CB)
LSAME
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
subroutine cgebal(JOB, N, A, LDA, ILO, IHI, SCALE, INFO)
CGEBAL
real function scnrm2(N, X, INCX)
SCNRM2
subroutine chseqr(JOB, COMPZ, N, ILO, IHI, H, LDH, W, Z, LDZ, WORK, LWORK, INFO)
CHSEQR
real function slamch(CMACH)
SLAMCH
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.
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 ...
subroutine cgehrd(N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO)
CGEHRD
subroutine slabad(SMALL, LARGE)
SLABAD
integer function ilaenv(ISPEC, NAME, OPTS, N1, N2, N3, N4)
subroutine csscal(N, SA, CX, INCX)
CSSCAL
subroutine cgebak(JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV, INFO)
CGEBAK
subroutine ctrevc(SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, LDVR, MM, M, WORK, RWORK, INFO)
CTREVC
subroutine cunghr(N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO)
CUNGHR