190 SUBROUTINE dgeev( JOBVL, JOBVR, N, A, LDA, WR, WI, VL, LDVL, VR,
191 $ LDVR, WORK, LWORK, INFO )
199 CHARACTER JOBVL, JOBVR
200 INTEGER INFO, LDA, LDVL, LDVR, LWORK, N
203 DOUBLE PRECISION A( LDA, * ), VL( LDVL, * ), VR( LDVR, * ),
204 $ wi( * ), work( * ), wr( * )
210 DOUBLE PRECISION ZERO, ONE
211 parameter( zero = 0.0d0, one = 1.0d0 )
214 LOGICAL LQUERY, SCALEA, WANTVL, WANTVR
216 INTEGER HSWORK, I, IBAL, IERR, IHI, ILO, ITAU, IWRK, K,
217 $ lwork_trevc, maxwrk, minwrk, nout
218 DOUBLE PRECISION ANRM, BIGNUM, CS, CSCALE, EPS, R, SCL, SMLNUM,
223 DOUBLE PRECISION DUM( 1 )
232 INTEGER IDAMAX, ILAENV
233 DOUBLE PRECISION DLAMCH, DLANGE, DLAPY2, DNRM2
234 EXTERNAL lsame, idamax, ilaenv, dlamch, dlange, dlapy2,
245 lquery = ( lwork.EQ.-1 )
246 wantvl = lsame( jobvl,
'V' )
247 wantvr = lsame( jobvr,
'V' )
248 IF( ( .NOT.wantvl ) .AND. ( .NOT.lsame( jobvl,
'N' ) ) )
THEN
250 ELSE IF( ( .NOT.wantvr ) .AND. ( .NOT.lsame( jobvr,
'N' ) ) )
THEN
252 ELSE IF( n.LT.0 )
THEN
254 ELSE IF( lda.LT.max( 1, n ) )
THEN
256 ELSE IF( ldvl.LT.1 .OR. ( wantvl .AND. ldvl.LT.n ) )
THEN
258 ELSE IF( ldvr.LT.1 .OR. ( wantvr .AND. ldvr.LT.n ) )
THEN
277 maxwrk = 2*n + n*ilaenv( 1,
'DGEHRD',
' ', n, 1, n, 0 )
280 maxwrk = max( maxwrk, 2*n + ( n - 1 )*ilaenv( 1,
281 $
'DORGHR',
' ', n, 1, n, -1 ) )
282 CALL dhseqr(
'S',
'V', n, 1, n, a, lda, wr, wi, vl, ldvl,
284 hswork = int( work(1) )
285 maxwrk = max( maxwrk, n + 1, n + hswork )
286 CALL dtrevc3(
'L',
'B',
SELECT, n, a, lda,
287 $ vl, ldvl, vr, ldvr, n, nout,
289 lwork_trevc = int( work(1) )
290 maxwrk = max( maxwrk, n + lwork_trevc )
291 maxwrk = max( maxwrk, 4*n )
292 ELSE IF( wantvr )
THEN
294 maxwrk = max( maxwrk, 2*n + ( n - 1 )*ilaenv( 1,
295 $
'DORGHR',
' ', n, 1, n, -1 ) )
296 CALL dhseqr(
'S',
'V', n, 1, n, a, lda, wr, wi, vr, ldvr,
298 hswork = int( work(1) )
299 maxwrk = max( maxwrk, n + 1, n + hswork )
300 CALL dtrevc3(
'R',
'B',
SELECT, n, a, lda,
301 $ vl, ldvl, vr, ldvr, n, nout,
303 lwork_trevc = int( work(1) )
304 maxwrk = max( maxwrk, n + lwork_trevc )
305 maxwrk = max( maxwrk, 4*n )
308 CALL dhseqr(
'E',
'N', n, 1, n, a, lda, wr, wi, vr, ldvr,
310 hswork = int( work(1) )
311 maxwrk = max( maxwrk, n + 1, n + hswork )
313 maxwrk = max( maxwrk, minwrk )
317 IF( lwork.LT.minwrk .AND. .NOT.lquery )
THEN
323 CALL xerbla(
'DGEEV ', -info )
325 ELSE IF( lquery )
THEN
337 smlnum = dlamch(
'S' )
338 bignum = one / smlnum
339 CALL dlabad( smlnum, bignum )
340 smlnum = sqrt( smlnum ) / eps
341 bignum = one / smlnum
345 anrm = dlange(
'M', n, n, a, lda, dum )
347 IF( anrm.GT.zero .AND. anrm.LT.smlnum )
THEN
350 ELSE IF( anrm.GT.bignum )
THEN
355 $
CALL dlascl(
'G', 0, 0, anrm, cscale, n, n, a, lda, ierr )
361 CALL dgebal(
'B', n, a, lda, ilo, ihi, work( ibal ), ierr )
368 CALL dgehrd( n, ilo, ihi, a, lda, work( itau ), work( iwrk ),
369 $ lwork-iwrk+1, ierr )
377 CALL dlacpy(
'L', n, n, a, lda, vl, ldvl )
382 CALL dorghr( n, ilo, ihi, vl, ldvl, work( itau ), work( iwrk ),
383 $ lwork-iwrk+1, ierr )
389 CALL dhseqr(
'S',
'V', n, ilo, ihi, a, lda, wr, wi, vl, ldvl,
390 $ work( iwrk ), lwork-iwrk+1, info )
398 CALL dlacpy(
'F', n, n, vl, ldvl, vr, ldvr )
401 ELSE IF( wantvr )
THEN
407 CALL dlacpy(
'L', n, n, a, lda, vr, ldvr )
412 CALL dorghr( n, ilo, ihi, vr, ldvr, work( itau ), work( iwrk ),
413 $ lwork-iwrk+1, ierr )
419 CALL dhseqr(
'S',
'V', n, ilo, ihi, a, lda, wr, wi, vr, ldvr,
420 $ work( iwrk ), lwork-iwrk+1, info )
428 CALL dhseqr(
'E',
'N', n, ilo, ihi, a, lda, wr, wi, vr, ldvr,
429 $ work( iwrk ), lwork-iwrk+1, info )
437 IF( wantvl .OR. wantvr )
THEN
442 CALL dtrevc3( side,
'B',
SELECT, n, a, lda, vl, ldvl, vr, ldvr,
443 $ n, nout, work( iwrk ), lwork-iwrk+1, ierr )
451 CALL dgebak(
'B',
'L', n, ilo, ihi, work( ibal ), n, vl, ldvl,
457 IF( wi( i ).EQ.zero )
THEN
458 scl = one / dnrm2( n, vl( 1, i ), 1 )
459 CALL dscal( n, scl, vl( 1, i ), 1 )
460 ELSE IF( wi( i ).GT.zero )
THEN
461 scl = one / dlapy2( dnrm2( n, vl( 1, i ), 1 ),
462 $ dnrm2( n, vl( 1, i+1 ), 1 ) )
463 CALL dscal( n, scl, vl( 1, i ), 1 )
464 CALL dscal( n, scl, vl( 1, i+1 ), 1 )
466 work( iwrk+k-1 ) = vl( k, i )**2 + vl( k, i+1 )**2
468 k = idamax( n, work( iwrk ), 1 )
469 CALL dlartg( vl( k, i ), vl( k, i+1 ), cs, sn, r )
470 CALL drot( n, vl( 1, i ), 1, vl( 1, i+1 ), 1, cs, sn )
481 CALL dgebak(
'B',
'R', n, ilo, ihi, work( ibal ), n, vr, ldvr,
487 IF( wi( i ).EQ.zero )
THEN
488 scl = one / dnrm2( n, vr( 1, i ), 1 )
489 CALL dscal( n, scl, vr( 1, i ), 1 )
490 ELSE IF( wi( i ).GT.zero )
THEN
491 scl = one / dlapy2( dnrm2( n, vr( 1, i ), 1 ),
492 $ dnrm2( n, vr( 1, i+1 ), 1 ) )
493 CALL dscal( n, scl, vr( 1, i ), 1 )
494 CALL dscal( n, scl, vr( 1, i+1 ), 1 )
496 work( iwrk+k-1 ) = vr( k, i )**2 + vr( k, i+1 )**2
498 k = idamax( n, work( iwrk ), 1 )
499 CALL dlartg( vr( k, i ), vr( k, i+1 ), cs, sn, r )
500 CALL drot( n, vr( 1, i ), 1, vr( 1, i+1 ), 1, cs, sn )
510 CALL dlascl(
'G', 0, 0, cscale, anrm, n-info, 1, wr( info+1 ),
511 $ max( n-info, 1 ), ierr )
512 CALL dlascl(
'G', 0, 0, cscale, anrm, n-info, 1, wi( info+1 ),
513 $ max( n-info, 1 ), ierr )
515 CALL dlascl(
'G', 0, 0, cscale, anrm, ilo-1, 1, wr, n,
517 CALL dlascl(
'G', 0, 0, cscale, anrm, ilo-1, 1, wi, n,
subroutine dlabad(SMALL, LARGE)
DLABAD
subroutine dlascl(TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO)
DLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.
subroutine dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
subroutine dlartg(f, g, c, s, r)
DLARTG generates a plane rotation with real cosine and real sine.
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine drot(N, DX, INCX, DY, INCY, C, S)
DROT
subroutine dscal(N, DA, DX, INCX)
DSCAL
subroutine dgehrd(N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO)
DGEHRD
subroutine dgebal(JOB, N, A, LDA, ILO, IHI, SCALE, INFO)
DGEBAL
subroutine dgebak(JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV, INFO)
DGEBAK
subroutine dgeev(JOBVL, JOBVR, N, A, LDA, WR, WI, VL, LDVL, VR, LDVR, WORK, LWORK, INFO)
DGEEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices
subroutine dhseqr(JOB, COMPZ, N, ILO, IHI, H, LDH, WR, WI, Z, LDZ, WORK, LWORK, INFO)
DHSEQR
subroutine dorghr(N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO)
DORGHR
subroutine dtrevc3(SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, LDVR, MM, M, WORK, LWORK, INFO)
DTREVC3