LAPACK 3.12.1
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ zlaqz0()

recursive subroutine zlaqz0 ( character, intent(in) wants,
character, intent(in) wantq,
character, intent(in) wantz,
integer, intent(in) n,
integer, intent(in) ilo,
integer, intent(in) ihi,
complex*16, dimension( lda, * ), intent(inout) a,
integer, intent(in) lda,
complex*16, dimension( ldb, * ), intent(inout) b,
integer, intent(in) ldb,
complex*16, dimension( * ), intent(inout) alpha,
complex*16, dimension( * ), intent(inout) beta,
complex*16, dimension( ldq, * ), intent(inout) q,
integer, intent(in) ldq,
complex*16, dimension( ldz, * ), intent(inout) z,
integer, intent(in) ldz,
complex*16, dimension( * ), intent(inout) work,
integer, intent(in) lwork,
double precision, dimension( * ), intent(out) rwork,
integer, intent(in) rec,
integer, intent(out) info )

ZLAQZ0

Download ZLAQZ0 + dependencies [TGZ] [ZIP] [TXT]

Purpose:
!>
!> ZLAQZ0 computes the eigenvalues of a real matrix pair (H,T),
!> where H is an upper Hessenberg matrix and T is upper triangular,
!> using the double-shift QZ method.
!> Matrix pairs of this type are produced by the reduction to
!> generalized upper Hessenberg form of a real matrix pair (A,B):
!>
!>    A = Q1*H*Z1**H,  B = Q1*T*Z1**H,
!>
!> as computed by ZGGHRD.
!>
!> If JOB='S', then the Hessenberg-triangular pair (H,T) is
!> also reduced to generalized Schur form,
!>
!>    H = Q*S*Z**H,  T = Q*P*Z**H,
!>
!> where Q and Z are unitary matrices, P and S are an upper triangular
!> matrices.
!>
!> Optionally, the unitary matrix Q from the generalized Schur
!> factorization may be postmultiplied into an input matrix Q1, and the
!> unitary matrix Z may be postmultiplied into an input matrix Z1.
!> If Q1 and Z1 are the unitary matrices from ZGGHRD that reduced
!> the matrix pair (A,B) to generalized upper Hessenberg form, then the
!> output matrices Q1*Q and Z1*Z are the unitary factors from the
!> generalized Schur factorization of (A,B):
!>
!>    A = (Q1*Q)*S*(Z1*Z)**H,  B = (Q1*Q)*P*(Z1*Z)**H.
!>
!> To avoid overflow, eigenvalues of the matrix pair (H,T) (equivalently,
!> of (A,B)) are computed as a pair of values (alpha,beta), where alpha is
!> complex and beta real.
!> If beta is nonzero, lambda = alpha / beta is an eigenvalue of the
!> generalized nonsymmetric eigenvalue problem (GNEP)
!>    A*x = lambda*B*x
!> and if alpha is nonzero, mu = beta / alpha is an eigenvalue of the
!> alternate form of the GNEP
!>    mu*A*y = B*y.
!> Eigenvalues can be read directly from the generalized Schur
!> form:
!>   alpha = S(i,i), beta = P(i,i).
!>
!> Ref: C.B. Moler & G.W. Stewart, , SIAM J. Numer. Anal., 10(1973),
!>      pp. 241--256.
!>
!> Ref: B. Kagstrom, D. Kressner, , SIAM J. Numer.
!>      Anal., 29(2006), pp. 199--227.
!>
!> Ref: T. Steel, D. Camps, K. Meerbergen, R. Vandebril 
!>
Parameters
[in]WANTS
!>          WANTS is CHARACTER*1
!>          = 'E': Compute eigenvalues only;
!>          = 'S': Compute eigenvalues and the Schur form.
!>
[in]WANTQ
!>          WANTQ is CHARACTER*1
!>          = 'N': Left Schur vectors (Q) are not computed;
!>          = 'I': Q is initialized to the unit matrix and the matrix Q
!>                 of left Schur vectors of (A,B) is returned;
!>          = 'V': Q must contain an unitary matrix Q1 on entry and
!>                 the product Q1*Q is returned.
!>
[in]WANTZ
!>          WANTZ is CHARACTER*1
!>          = 'N': Right Schur vectors (Z) are not computed;
!>          = 'I': Z is initialized to the unit matrix and the matrix Z
!>                 of right Schur vectors of (A,B) is returned;
!>          = 'V': Z must contain an unitary matrix Z1 on entry and
!>                 the product Z1*Z is returned.
!>
[in]N
!>          N is INTEGER
!>          The order of the matrices A, B, Q, and Z.  N >= 0.
!>
[in]ILO
!>          ILO is INTEGER
!>
[in]IHI
!>          IHI is INTEGER
!>          ILO and IHI mark the rows and columns of A which are in
!>          Hessenberg form.  It is assumed that A is already upper
!>          triangular in rows and columns 1:ILO-1 and IHI+1:N.
!>          If N > 0, 1 <= ILO <= IHI <= N; if N = 0, ILO=1 and IHI=0.
!>
[in,out]A
!>          A is COMPLEX*16 array, dimension (LDA, N)
!>          On entry, the N-by-N upper Hessenberg matrix A.
!>          On exit, if JOB = 'S', A contains the upper triangular
!>          matrix S from the generalized Schur factorization.
!>          If JOB = 'E', the diagonal blocks of A match those of S, but
!>          the rest of A is unspecified.
!>
[in]LDA
!>          LDA is INTEGER
!>          The leading dimension of the array A.  LDA >= max( 1, N ).
!>
[in,out]B
!>          B is COMPLEX*16 array, dimension (LDB, N)
!>          On entry, the N-by-N upper triangular matrix B.
!>          On exit, if JOB = 'S', B contains the upper triangular
!>          matrix P from the generalized Schur factorization;
!>          If JOB = 'E', the diagonal blocks of B match those of P, but
!>          the rest of B is unspecified.
!>
[in]LDB
!>          LDB is INTEGER
!>          The leading dimension of the array B.  LDB >= max( 1, N ).
!>
[out]ALPHA
!>          ALPHA is COMPLEX*16 array, dimension (N)
!>          Each scalar alpha defining an eigenvalue
!>          of GNEP.
!>
[out]BETA
!>          BETA is COMPLEX*16 array, dimension (N)
!>          The scalars beta that define the eigenvalues of GNEP.
!>          Together, the quantities alpha = ALPHA(j) and
!>          beta = BETA(j) represent the j-th eigenvalue of the matrix
!>          pair (A,B), in one of the forms lambda = alpha/beta or
!>          mu = beta/alpha.  Since either lambda or mu may overflow,
!>          they should not, in general, be computed.
!>
[in,out]Q
!>          Q is COMPLEX*16 array, dimension (LDQ, N)
!>          On entry, if COMPQ = 'V', the unitary matrix Q1 used in
!>          the reduction of (A,B) to generalized Hessenberg form.
!>          On exit, if COMPQ = 'I', the unitary matrix of left Schur
!>          vectors of (A,B), and if COMPQ = 'V', the unitary matrix
!>          of left Schur vectors of (A,B).
!>          Not referenced if COMPQ = 'N'.
!>
[in]LDQ
!>          LDQ is INTEGER
!>          The leading dimension of the array Q.  LDQ >= 1.
!>          If COMPQ='V' or 'I', then LDQ >= N.
!>
[in,out]Z
!>          Z is COMPLEX*16 array, dimension (LDZ, N)
!>          On entry, if COMPZ = 'V', the unitary matrix Z1 used in
!>          the reduction of (A,B) to generalized Hessenberg form.
!>          On exit, if COMPZ = 'I', the unitary matrix of
!>          right Schur vectors of (H,T), and if COMPZ = 'V', the
!>          unitary matrix of right Schur vectors of (A,B).
!>          Not referenced if COMPZ = 'N'.
!>
[in]LDZ
!>          LDZ is INTEGER
!>          The leading dimension of the array Z.  LDZ >= 1.
!>          If COMPZ='V' or 'I', then LDZ >= N.
!>
[out]WORK
!>          WORK is COMPLEX*16 array, dimension (MAX(1,LWORK))
!>          On exit, if INFO >= 0, WORK(1) returns the optimal LWORK.
!>
[out]RWORK
!>          RWORK is DOUBLE PRECISION array, dimension (N)
!>
[in]LWORK
!>          LWORK is INTEGER
!>          The dimension of the array WORK.  LWORK >= max(1,N).
!>
!>          If LWORK = -1, then a workspace query is assumed; the routine
!>          only calculates the optimal size of the WORK array, returns
!>          this value as the first entry of the WORK array, and no error
!>          message related to LWORK is issued by XERBLA.
!>
[in]REC
!>          REC is INTEGER
!>             REC indicates the current recursion level. Should be set
!>             to 0 on first call.
!>
[out]INFO
!>          INFO is INTEGER
!>          = 0: successful exit
!>          < 0: if INFO = -i, the i-th argument had an illegal value
!>          = 1,...,N: the QZ iteration did not converge.  (A,B) is not
!>                     in Schur form, but ALPHA(i) and
!>                     BETA(i), i=INFO+1,...,N should be correct.
!>
Author
Thijs Steel, KU Leuven
Date
May 2020

Definition at line 278 of file zlaqz0.f.

283 IMPLICIT NONE
284
285* Arguments
286 CHARACTER, INTENT( IN ) :: WANTS, WANTQ, WANTZ
287 INTEGER, INTENT( IN ) :: N, ILO, IHI, LDA, LDB, LDQ, LDZ, LWORK,
288 $ REC
289 INTEGER, INTENT( OUT ) :: INFO
290 COMPLEX*16, INTENT( INOUT ) :: A( LDA, * ), B( LDB, * ), Q( LDQ,
291 $ * ), Z( LDZ, * ), ALPHA( * ), BETA( * ), WORK( * )
292 DOUBLE PRECISION, INTENT( OUT ) :: RWORK( * )
293
294* Parameters
295 COMPLEX*16 CZERO, CONE
296 parameter( czero = ( 0.0d+0, 0.0d+0 ), cone = ( 1.0d+0,
297 $ 0.0d+0 ) )
298 DOUBLE PRECISION :: ZERO, ONE, HALF
299 parameter( zero = 0.0d0, one = 1.0d0, half = 0.5d0 )
300
301* Local scalars
302 DOUBLE PRECISION :: SMLNUM, ULP, SAFMIN, SAFMAX, C1, TEMPR,
303 $ BNORM, BTOL
304 COMPLEX*16 :: ESHIFT, S1, TEMP
305 INTEGER :: ISTART, ISTOP, IITER, MAXIT, ISTART2, K, LD, NSHIFTS,
306 $ NBLOCK, NW, NMIN, NIBBLE, N_UNDEFLATED, N_DEFLATED,
307 $ NS, SWEEP_INFO, SHIFTPOS, LWORKREQ, K2, ISTARTM,
308 $ ISTOPM, IWANTS, IWANTQ, IWANTZ, NORM_INFO, AED_INFO,
309 $ NWR, NBR, NSR, ITEMP1, ITEMP2, RCOST
310 LOGICAL :: ILSCHUR, ILQ, ILZ
311 CHARACTER :: JBCMPZ*3
312
313* External Functions
314 EXTERNAL :: xerbla, zhgeqz, zlaqz2, zlaqz3, zlaset,
315 $ zlartg, zrot
316 DOUBLE PRECISION, EXTERNAL :: DLAMCH, ZLANHS
317 LOGICAL, EXTERNAL :: LSAME
318 INTEGER, EXTERNAL :: ILAENV
319
320*
321* Decode wantS,wantQ,wantZ
322*
323 IF( lsame( wants, 'E' ) ) THEN
324 ilschur = .false.
325 iwants = 1
326 ELSE IF( lsame( wants, 'S' ) ) THEN
327 ilschur = .true.
328 iwants = 2
329 ELSE
330 iwants = 0
331 END IF
332
333 IF( lsame( wantq, 'N' ) ) THEN
334 ilq = .false.
335 iwantq = 1
336 ELSE IF( lsame( wantq, 'V' ) ) THEN
337 ilq = .true.
338 iwantq = 2
339 ELSE IF( lsame( wantq, 'I' ) ) THEN
340 ilq = .true.
341 iwantq = 3
342 ELSE
343 iwantq = 0
344 END IF
345
346 IF( lsame( wantz, 'N' ) ) THEN
347 ilz = .false.
348 iwantz = 1
349 ELSE IF( lsame( wantz, 'V' ) ) THEN
350 ilz = .true.
351 iwantz = 2
352 ELSE IF( lsame( wantz, 'I' ) ) THEN
353 ilz = .true.
354 iwantz = 3
355 ELSE
356 iwantz = 0
357 END IF
358*
359* Check Argument Values
360*
361 info = 0
362 IF( iwants.EQ.0 ) THEN
363 info = -1
364 ELSE IF( iwantq.EQ.0 ) THEN
365 info = -2
366 ELSE IF( iwantz.EQ.0 ) THEN
367 info = -3
368 ELSE IF( n.LT.0 ) THEN
369 info = -4
370 ELSE IF( ilo.LT.1 ) THEN
371 info = -5
372 ELSE IF( ihi.GT.n .OR. ihi.LT.ilo-1 ) THEN
373 info = -6
374 ELSE IF( lda.LT.n ) THEN
375 info = -8
376 ELSE IF( ldb.LT.n ) THEN
377 info = -10
378 ELSE IF( ldq.LT.1 .OR. ( ilq .AND. ldq.LT.n ) ) THEN
379 info = -15
380 ELSE IF( ldz.LT.1 .OR. ( ilz .AND. ldz.LT.n ) ) THEN
381 info = -17
382 END IF
383 IF( info.NE.0 ) THEN
384 CALL xerbla( 'ZLAQZ0', -info )
385 RETURN
386 END IF
387
388*
389* Quick return if possible
390*
391 IF( n.LE.0 ) THEN
392 work( 1 ) = dble( 1 )
393 RETURN
394 END IF
395
396*
397* Get the parameters
398*
399 jbcmpz( 1:1 ) = wants
400 jbcmpz( 2:2 ) = wantq
401 jbcmpz( 3:3 ) = wantz
402
403 nmin = ilaenv( 12, 'ZLAQZ0', jbcmpz, n, ilo, ihi, lwork )
404
405 nwr = ilaenv( 13, 'ZLAQZ0', jbcmpz, n, ilo, ihi, lwork )
406 nwr = max( 2, nwr )
407 nwr = min( ihi-ilo+1, ( n-1 ) / 3, nwr )
408
409 nibble = ilaenv( 14, 'ZLAQZ0', jbcmpz, n, ilo, ihi, lwork )
410
411 nsr = ilaenv( 15, 'ZLAQZ0', jbcmpz, n, ilo, ihi, lwork )
412 nsr = min( nsr, ( n+6 ) / 9, ihi-ilo )
413 nsr = max( 2, nsr-mod( nsr, 2 ) )
414
415 rcost = ilaenv( 17, 'ZLAQZ0', jbcmpz, n, ilo, ihi, lwork )
416 itemp1 = int( nsr/sqrt( 1+2*nsr/( dble( rcost )/100*n ) ) )
417 itemp1 = ( ( itemp1-1 )/4 )*4+4
418 nbr = nsr+itemp1
419
420 IF( n .LT. nmin .OR. rec .GE. 2 ) THEN
421 CALL zhgeqz( wants, wantq, wantz, n, ilo, ihi, a, lda, b,
422 $ ldb,
423 $ alpha, beta, q, ldq, z, ldz, work, lwork, rwork,
424 $ info )
425 RETURN
426 END IF
427
428*
429* Find out required workspace
430*
431
432* Workspace query to ZLAQZ2
433 nw = max( nwr, nmin )
434 CALL zlaqz2( ilschur, ilq, ilz, n, ilo, ihi, nw, a, lda, b,
435 $ ldb,
436 $ q, ldq, z, ldz, n_undeflated, n_deflated, alpha,
437 $ beta, work, nw, work, nw, work, -1, rwork, rec,
438 $ aed_info )
439 itemp1 = int( work( 1 ) )
440* Workspace query to ZLAQZ3
441 CALL zlaqz3( ilschur, ilq, ilz, n, ilo, ihi, nsr, nbr, alpha,
442 $ beta, a, lda, b, ldb, q, ldq, z, ldz, work, nbr,
443 $ work, nbr, work, -1, sweep_info )
444 itemp2 = int( work( 1 ) )
445
446 lworkreq = max( itemp1+2*nw**2, itemp2+2*nbr**2 )
447 IF ( lwork .EQ.-1 ) THEN
448 work( 1 ) = dble( lworkreq )
449 RETURN
450 ELSE IF ( lwork .LT. lworkreq ) THEN
451 info = -19
452 END IF
453 IF( info.NE.0 ) THEN
454 CALL xerbla( 'ZLAQZ0', info )
455 RETURN
456 END IF
457*
458* Initialize Q and Z
459*
460 IF( iwantq.EQ.3 ) CALL zlaset( 'FULL', n, n, czero, cone, q,
461 $ ldq )
462 IF( iwantz.EQ.3 ) CALL zlaset( 'FULL', n, n, czero, cone, z,
463 $ ldz )
464
465* Get machine constants
466 safmin = dlamch( 'SAFE MINIMUM' )
467 safmax = one/safmin
468 ulp = dlamch( 'PRECISION' )
469 smlnum = safmin*( dble( n )/ulp )
470
471 bnorm = zlanhs( 'F', ihi-ilo+1, b( ilo, ilo ), ldb, rwork )
472 btol = max( safmin, ulp*bnorm )
473
474 istart = ilo
475 istop = ihi
476 maxit = 30*( ihi-ilo+1 )
477 ld = 0
478
479 DO iiter = 1, maxit
480 IF( iiter .GE. maxit ) THEN
481 info = istop+1
482 GOTO 80
483 END IF
484 IF ( istart+1 .GE. istop ) THEN
485 istop = istart
486 EXIT
487 END IF
488
489* Check deflations at the end
490 IF ( abs( a( istop, istop-1 ) ) .LE. max( smlnum,
491 $ ulp*( abs( a( istop, istop ) )+abs( a( istop-1,
492 $ istop-1 ) ) ) ) ) THEN
493 a( istop, istop-1 ) = czero
494 istop = istop-1
495 ld = 0
496 eshift = czero
497 END IF
498* Check deflations at the start
499 IF ( abs( a( istart+1, istart ) ) .LE. max( smlnum,
500 $ ulp*( abs( a( istart, istart ) )+abs( a( istart+1,
501 $ istart+1 ) ) ) ) ) THEN
502 a( istart+1, istart ) = czero
503 istart = istart+1
504 ld = 0
505 eshift = czero
506 END IF
507
508 IF ( istart+1 .GE. istop ) THEN
509 EXIT
510 END IF
511
512* Check interior deflations
513 istart2 = istart
514 DO k = istop, istart+1, -1
515 IF ( abs( a( k, k-1 ) ) .LE. max( smlnum, ulp*( abs( a( k,
516 $ k ) )+abs( a( k-1, k-1 ) ) ) ) ) THEN
517 a( k, k-1 ) = czero
518 istart2 = k
519 EXIT
520 END IF
521 END DO
522
523* Get range to apply rotations to
524 IF ( ilschur ) THEN
525 istartm = 1
526 istopm = n
527 ELSE
528 istartm = istart2
529 istopm = istop
530 END IF
531
532* Check infinite eigenvalues, this is done without blocking so might
533* slow down the method when many infinite eigenvalues are present
534 k = istop
535 DO WHILE ( k.GE.istart2 )
536
537 IF( abs( b( k, k ) ) .LT. btol ) THEN
538* A diagonal element of B is negligible, move it
539* to the top and deflate it
540
541 DO k2 = k, istart2+1, -1
542 CALL zlartg( b( k2-1, k2 ), b( k2-1, k2-1 ), c1,
543 $ s1,
544 $ temp )
545 b( k2-1, k2 ) = temp
546 b( k2-1, k2-1 ) = czero
547
548 CALL zrot( k2-2-istartm+1, b( istartm, k2 ), 1,
549 $ b( istartm, k2-1 ), 1, c1, s1 )
550 CALL zrot( min( k2+1, istop )-istartm+1,
551 $ a( istartm,
552 $ k2 ), 1, a( istartm, k2-1 ), 1, c1, s1 )
553 IF ( ilz ) THEN
554 CALL zrot( n, z( 1, k2 ), 1, z( 1, k2-1 ), 1,
555 $ c1,
556 $ s1 )
557 END IF
558
559 IF( k2.LT.istop ) THEN
560 CALL zlartg( a( k2, k2-1 ), a( k2+1, k2-1 ), c1,
561 $ s1, temp )
562 a( k2, k2-1 ) = temp
563 a( k2+1, k2-1 ) = czero
564
565 CALL zrot( istopm-k2+1, a( k2, k2 ), lda,
566 $ a( k2+1,
567 $ k2 ), lda, c1, s1 )
568 CALL zrot( istopm-k2+1, b( k2, k2 ), ldb,
569 $ b( k2+1,
570 $ k2 ), ldb, c1, s1 )
571 IF( ilq ) THEN
572 CALL zrot( n, q( 1, k2 ), 1, q( 1, k2+1 ), 1,
573 $ c1, dconjg( s1 ) )
574 END IF
575 END IF
576
577 END DO
578
579 IF( istart2.LT.istop )THEN
580 CALL zlartg( a( istart2, istart2 ), a( istart2+1,
581 $ istart2 ), c1, s1, temp )
582 a( istart2, istart2 ) = temp
583 a( istart2+1, istart2 ) = czero
584
585 CALL zrot( istopm-( istart2+1 )+1, a( istart2,
586 $ istart2+1 ), lda, a( istart2+1,
587 $ istart2+1 ), lda, c1, s1 )
588 CALL zrot( istopm-( istart2+1 )+1, b( istart2,
589 $ istart2+1 ), ldb, b( istart2+1,
590 $ istart2+1 ), ldb, c1, s1 )
591 IF( ilq ) THEN
592 CALL zrot( n, q( 1, istart2 ), 1, q( 1,
593 $ istart2+1 ), 1, c1, dconjg( s1 ) )
594 END IF
595 END IF
596
597 istart2 = istart2+1
598
599 END IF
600 k = k-1
601 END DO
602
603* istart2 now points to the top of the bottom right
604* unreduced Hessenberg block
605 IF ( istart2 .GE. istop ) THEN
606 istop = istart2-1
607 ld = 0
608 eshift = czero
609 cycle
610 END IF
611
612 nw = nwr
613 nshifts = nsr
614 nblock = nbr
615
616 IF ( istop-istart2+1 .LT. nmin ) THEN
617* Setting nw to the size of the subblock will make AED deflate
618* all the eigenvalues. This is slightly more efficient than just
619* using qz_small because the off diagonal part gets updated via BLAS.
620 IF ( istop-istart+1 .LT. nmin ) THEN
621 nw = istop-istart+1
622 istart2 = istart
623 ELSE
624 nw = istop-istart2+1
625 END IF
626 END IF
627
628*
629* Time for AED
630*
631 CALL zlaqz2( ilschur, ilq, ilz, n, istart2, istop, nw, a,
632 $ lda,
633 $ b, ldb, q, ldq, z, ldz, n_undeflated, n_deflated,
634 $ alpha, beta, work, nw, work( nw**2+1 ), nw,
635 $ work( 2*nw**2+1 ), lwork-2*nw**2, rwork, rec,
636 $ aed_info )
637
638 IF ( n_deflated > 0 ) THEN
639 istop = istop-n_deflated
640 ld = 0
641 eshift = czero
642 END IF
643
644 IF ( 100*n_deflated > nibble*( n_deflated+n_undeflated ) .OR.
645 $ istop-istart2+1 .LT. nmin ) THEN
646* AED has uncovered many eigenvalues. Skip a QZ sweep and run
647* AED again.
648 cycle
649 END IF
650
651 ld = ld+1
652
653 ns = min( nshifts, istop-istart2 )
654 ns = min( ns, n_undeflated )
655 shiftpos = istop-n_undeflated+1
656
657 IF ( mod( ld, 6 ) .EQ. 0 ) THEN
658*
659* Exceptional shift. Chosen for no particularly good reason.
660*
661 IF( ( dble( maxit )*safmin )*abs( a( istop,
662 $ istop-1 ) ).LT.abs( a( istop-1, istop-1 ) ) ) THEN
663 eshift = a( istop, istop-1 )/b( istop-1, istop-1 )
664 ELSE
665 eshift = eshift+cone/( safmin*dble( maxit ) )
666 END IF
667 alpha( shiftpos ) = cone
668 beta( shiftpos ) = eshift
669 ns = 1
670 END IF
671
672*
673* Time for a QZ sweep
674*
675 CALL zlaqz3( ilschur, ilq, ilz, n, istart2, istop, ns,
676 $ nblock,
677 $ alpha( shiftpos ), beta( shiftpos ), a, lda, b,
678 $ ldb, q, ldq, z, ldz, work, nblock, work( nblock**
679 $ 2+1 ), nblock, work( 2*nblock**2+1 ),
680 $ lwork-2*nblock**2, sweep_info )
681
682 END DO
683
684*
685* Call ZHGEQZ to normalize the eigenvalue blocks and set the eigenvalues
686* If all the eigenvalues have been found, ZHGEQZ will not do any iterations
687* and only normalize the blocks. In case of a rare convergence failure,
688* the single shift might perform better.
689*
690 80 CALL zhgeqz( wants, wantq, wantz, n, ilo, ihi, a, lda, b, ldb,
691 $ alpha, beta, q, ldq, z, ldz, work, lwork, rwork,
692 $ norm_info )
693
694 info = norm_info
695
xerbla
subroutine xerbla(srname, info)
Definition cblat2.f:3285
zhgeqz
subroutine zhgeqz(job, compq, compz, n, ilo, ihi, h, ldh, t, ldt, alpha, beta, q, ldq, z, ldz, work, lwork, rwork, info)
ZHGEQZ
Definition zhgeqz.f:283
ilaenv
integer function ilaenv(ispec, name, opts, n1, n2, n3, n4)
ILAENV
Definition ilaenv.f:160
dlamch
double precision function dlamch(cmach)
DLAMCH
Definition dlamch.f:69
zlanhs
double precision function zlanhs(norm, n, a, lda, work)
ZLANHS returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
Definition zlanhs.f:107
zlaqz2
recursive subroutine zlaqz2(ilschur, ilq, ilz, n, ilo, ihi, nw, a, lda, b, ldb, q, ldq, z, ldz, ns, nd, alpha, beta, qc, ldqc, zc, ldzc, work, lwork, rwork, rec, info)
ZLAQZ2
Definition zlaqz2.f:233
zlaqz3
subroutine zlaqz3(ilschur, ilq, ilz, n, ilo, ihi, nshifts, nblock_desired, alpha, beta, a, lda, b, ldb, q, ldq, z, ldz, qc, ldqc, zc, ldzc, work, lwork, info)
ZLAQZ3
Definition zlaqz3.f:206
zlartg
subroutine zlartg(f, g, c, s, r)
ZLARTG generates a plane rotation with real cosine and complex sine.
Definition zlartg.f90:116
zlaset
subroutine zlaset(uplo, m, n, alpha, beta, a, lda)
ZLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values.
Definition zlaset.f:104
lsame
logical function lsame(ca, cb)
LSAME
Definition lsame.f:48
zrot
subroutine zrot(n, cx, incx, cy, incy, c, s)
ZROT applies a plane rotation with real cosine and complex sine to a pair of complex vectors.
Definition zrot.f:101
Here is the call graph for this function:
Here is the caller graph for this function: