178 SUBROUTINE cgeev( JOBVL, JOBVR, N, A, LDA, W, VL, LDVL, VR, LDVR,
179 $ WORK, LWORK, RWORK, INFO )
187 CHARACTER JOBVL, JOBVR
188 INTEGER INFO, LDA, LDVL, LDVR, LWORK, N
192 COMPLEX A( LDA, * ), VL( LDVL, * ), VR( LDVR, * ),
200 parameter( zero = 0.0e0, one = 1.0e0 )
203 LOGICAL LQUERY, SCALEA, WANTVL, WANTVR
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
220 INTEGER ISAMAX, ILAENV
221 REAL SLAMCH, SCNRM2, CLANGE
222 EXTERNAL lsame, isamax, ilaenv, slamch, scnrm2, clange
225 INTRINSIC real, cmplx, conjg, aimag, max, sqrt
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
237 ELSE IF( ( .NOT.wantvr ) .AND. ( .NOT.lsame( jobvr,
'N' ) ) )
THEN
239 ELSE IF( n.LT.0 )
THEN
241 ELSE IF( lda.LT.max( 1, n ) )
THEN
243 ELSE IF( ldvl.LT.1 .OR. ( wantvl .AND. ldvl.LT.n ) )
THEN
245 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 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,
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,
288 CALL chseqr(
'E',
'N', n, 1, n, a, lda, w, vr, ldvr,
291 hswork = int( work(1) )
292 maxwrk = max( maxwrk, hswork, minwrk )
296 IF( lwork.LT.minwrk .AND. .NOT.lquery )
THEN
302 CALL xerbla(
'CGEEV ', -info )
304 ELSE IF( lquery )
THEN
316 smlnum = slamch(
'S' )
317 bignum = one / smlnum
318 CALL slabad( smlnum, bignum )
319 smlnum = sqrt( smlnum ) / eps
320 bignum = one / smlnum
324 anrm = clange(
'M', n, n, a, lda, dum )
326 IF( anrm.GT.zero .AND. anrm.LT.smlnum )
THEN
329 ELSE IF( anrm.GT.bignum )
THEN
334 $
CALL clascl(
'G', 0, 0, anrm, cscale, n, n, a, lda, ierr )
341 CALL cgebal(
'B', n, a, lda, ilo, ihi, rwork( ibal ), ierr )
349 CALL cgehrd( n, ilo, ihi, a, lda, work( itau ), work( iwrk ),
350 $ lwork-iwrk+1, ierr )
358 CALL clacpy(
'L', n, n, a, lda, vl, ldvl )
364 CALL cunghr( n, ilo, ihi, vl, ldvl, work( itau ), work( iwrk ),
365 $ lwork-iwrk+1, ierr )
372 CALL chseqr(
'S',
'V', n, ilo, ihi, a, lda, w, vl, ldvl,
373 $ work( iwrk ), lwork-iwrk+1, info )
381 CALL clacpy(
'F', n, n, vl, ldvl, vr, ldvr )
384 ELSE IF( wantvr )
THEN
390 CALL clacpy(
'L', n, n, a, lda, vr, ldvr )
396 CALL cunghr( n, ilo, ihi, vr, ldvr, work( itau ), work( iwrk ),
397 $ lwork-iwrk+1, ierr )
404 CALL chseqr(
'S',
'V', n, ilo, ihi, a, lda, w, vr, ldvr,
405 $ work( iwrk ), lwork-iwrk+1, info )
414 CALL chseqr(
'E',
'N', n, ilo, ihi, a, lda, w, vr, ldvr,
415 $ work( iwrk ), lwork-iwrk+1, info )
423 IF( wantvl .OR. wantvr )
THEN
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 )
441 CALL cgebak(
'B',
'L', n, ilo, ihi, rwork( ibal ), n, vl, ldvl,
447 scl = one / scnrm2( n, vl( 1, i ), 1 )
448 CALL csscal( n, scl, vl( 1, i ), 1 )
450 rwork( irwork+k-1 ) = real( vl( k, i ) )**2 +
451 $ aimag( vl( k, i ) )**2
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 )
466 CALL cgebak(
'B',
'R', n, ilo, ihi, rwork( ibal ), n, vr, ldvr,
472 scl = one / scnrm2( n, vr( 1, i ), 1 )
473 CALL csscal( n, scl, vr( 1, i ), 1 )
475 rwork( irwork+k-1 ) = real( vr( k, i ) )**2 +
476 $ aimag( vr( k, i ) )**2
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 )
489 CALL clascl(
'G', 0, 0, cscale, anrm, n-info, 1, w( info+1 ),
490 $ max( n-info, 1 ), ierr )
492 CALL clascl(
'G', 0, 0, cscale, anrm, ilo-1, 1, w, n, ierr )
subroutine slabad(SMALL, LARGE)
SLABAD
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine csscal(N, SA, CX, INCX)
CSSCAL
subroutine cscal(N, CA, CX, INCX)
CSCAL
subroutine cgehrd(N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO)
CGEHRD
subroutine cgebal(JOB, N, A, LDA, ILO, IHI, SCALE, INFO)
CGEBAL
subroutine cgebak(JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV, INFO)
CGEBAK
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 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 clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
subroutine ctrevc3(SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, LDVR, MM, M, WORK, LWORK, RWORK, LRWORK, INFO)
CTREVC3
subroutine cunghr(N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO)
CUNGHR
subroutine chseqr(JOB, COMPZ, N, ILO, IHI, H, LDH, W, Z, LDZ, WORK, LWORK, INFO)
CHSEQR