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
219 INTEGER ILAENV, ISAMAX
220 REAL CLANGE, SCNRM2, SLAMCH
221 EXTERNAL lsame, ilaenv, isamax, clange, scnrm2, slamch
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
306 smlnum = slamch(
'S' )
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 )
subroutine cscal(N, CA, CX, INCX)
CSCAL
subroutine xerbla(SRNAME, INFO)
XERBLA
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
subroutine chseqr(JOB, COMPZ, N, ILO, IHI, H, LDH, W, Z, LDZ, WORK, LWORK, INFO)
CHSEQR
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
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