SLAHQR - i an auxiliary routine called by SHSEQR to update
       the eigenvalues and Schur decomposition  already  computed
       by  SHSEQR,  by  dealing  with the Hessenberg submatrix in
       rows and columns ILO to IHI


SYNOPSIS

       SUBROUTINE SLAHQR( WANTT, WANTZ, N, ILO, IHI, H, LDH,  WR,
                          WI, ILOZ, IHIZ, Z, LDZ, INFO )

           LOGICAL        WANTT, WANTZ

           INTEGER        IHI, IHIZ, ILO, ILOZ, INFO, LDH, LDZ, N

           REAL           H( LDH, * ), WI( * ), WR( * ), Z(  LDZ,
                          * )


PURPOSE

       SLAHQR  is an auxiliary routine called by SHSEQR to update
       the eigenvalues and Schur decomposition  already  computed
       by  SHSEQR,  by  dealing  with the Hessenberg submatrix in
       rows and columns ILO to IHI.


ARGUMENTS

       WANTT   (input) LOGICAL
               = .TRUE. : the full Schur form T is required;
               = .FALSE.: only eigenvalues are required.

       WANTZ   (input) LOGICAL
               = .TRUE. :  the  matrix  of  Schur  vectors  Z  is
               required;
               = .FALSE.: Schur vectors are not required.

       N       (input) INTEGER
               The order of the matrix H.  N >= 0.

       ILO     (input) INTEGER
               IHI      (input)  INTEGER  It is assumed that H is
               already upper quasi-triangular in rows and columns
               IHI+1:N,  and  that H(ILO,ILO-1) = 0 (unless ILO =
               1). SLAHQR works  primarily  with  the  Hessenberg
               submatrix  in  rows  and  columns  ILO to IHI, but
               applies transformations to all of H  if  WANTT  is
               .TRUE..  1 <= ILO <= max(1,IHI); IHI <= N.

       H       (input/output) REAL array, dimension (LDH,N)
               On entry, the upper Hessenberg matrix H.  On exit,
               if WANTT is .TRUE., H is upper quasi-triangular in
               rows and columns ILO:IHI, with any 2-by-2 diagonal
               blocks in standard form. If WANTT is .FALSE.,  the
               contents of H are unspecified on exit.

       LDH     (input) INTEGER
               The  leading  dimension  of  the  array  H. LDH >=


       WR      (output) REAL array, dimension (N)
               WI      (output) REAL  array,  dimension  (N)  The
               real  and  imaginary  parts,  respectively, of the
               computed eigenvalues ILO to IHI are stored in  the
               corresponding elements of WR and WI. If two eigen­
               values are computed as a complex  conjugate  pair,
               they  are stored in consecutive elements of WR and
               WI, say the i-th and (i+1)th, with WI(i) >  0  and
               WI(i+1)  <  0. If WANTT is .TRUE., the eigenvalues
               are stored in the same order as on the diagonal of
               the Schur form returned in H, with WR(i) = H(i,i),
               and, if H(i:i+1,i:i+1) is a 2-by-2 diagonal block,
               WI(i)  =  sqrt(H(i+1,i)*H(i,i+1))  and  WI(i+1)  =
               -WI(i).

       ILOZ    (input) INTEGER
               IHIZ    (input) INTEGER Specify the rows of  Z  to
               which  transformations must be applied if WANTZ is
               .TRUE..  1 <= ILOZ <= ILO; IHI <= IHIZ <= N.

       Z       (input/output) REAL array, dimension (LDZ,N)
               If WANTZ is .TRUE., on entry Z  must  contain  the
               current matrix Z of transformations accumulated by
               SHSEQR, and on exit Z has been updated;  transfor­
               mations   are   applied   only  to  the  submatrix
               Z(ILOZ:IHIZ,ILO:IHI).  If WANTZ is .FALSE.,  Z  is
               not referenced.

       LDZ     (input) INTEGER
               The  leading  dimension  of  the  array  Z. LDZ >=
               max(1,N).

       INFO    (output) INTEGER
               = 0: successful exit
               > 0: SLAHQR failed to compute all the  eigenvalues
               ILO  to  IHI  in  a total of 30*(IHI-ILO+1) itera­
               tions; if INFO = i, elements i+1:ihi of WR and  WI
               contain those eigenvalues which have been success­
               fully computed.


FURTHER DETAILS

       2-96 Based on modifications by
          David Day, Sandia National Laboratory, USA


Man(1) output converted with man2html