File:  [local] / rpl / lapack / lapack / zhseqr.f
Revision 1.9: download - view: text, annotated - select for diffs - revision graph
Mon Nov 21 20:43:13 2011 UTC (12 years, 6 months ago) by bertrand
Branches: MAIN
CVS tags: HEAD
Mise à jour de Lapack.

    1: *> \brief \b ZHSEQR
    2: *
    3: *  =========== DOCUMENTATION ===========
    4: *
    5: * Online html documentation available at 
    6: *            http://www.netlib.org/lapack/explore-html/ 
    7: *
    8: *> \htmlonly
    9: *> Download ZHSEQR + dependencies 
   10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zhseqr.f"> 
   11: *> [TGZ]</a> 
   12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zhseqr.f"> 
   13: *> [ZIP]</a> 
   14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zhseqr.f"> 
   15: *> [TXT]</a>
   16: *> \endhtmlonly 
   17: *
   18: *  Definition:
   19: *  ===========
   20: *
   21: *       SUBROUTINE ZHSEQR( JOB, COMPZ, N, ILO, IHI, H, LDH, W, Z, LDZ,
   22: *                          WORK, LWORK, INFO )
   23:    24: *       .. Scalar Arguments ..
   25: *       INTEGER            IHI, ILO, INFO, LDH, LDZ, LWORK, N
   26: *       CHARACTER          COMPZ, JOB
   27: *       ..
   28: *       .. Array Arguments ..
   29: *       COMPLEX*16         H( LDH, * ), W( * ), WORK( * ), Z( LDZ, * )
   30: *       ..
   31: *  
   32: *
   33: *> \par Purpose:
   34: *  =============
   35: *>
   36: *> \verbatim
   37: *>
   38: *>    ZHSEQR computes the eigenvalues of a Hessenberg matrix H
   39: *>    and, optionally, the matrices T and Z from the Schur decomposition
   40: *>    H = Z T Z**H, where T is an upper triangular matrix (the
   41: *>    Schur form), and Z is the unitary matrix of Schur vectors.
   42: *>
   43: *>    Optionally Z may be postmultiplied into an input unitary
   44: *>    matrix Q so that this routine can give the Schur factorization
   45: *>    of a matrix A which has been reduced to the Hessenberg form H
   46: *>    by the unitary matrix Q:  A = Q*H*Q**H = (QZ)*H*(QZ)**H.
   47: *> \endverbatim
   48: *
   49: *  Arguments:
   50: *  ==========
   51: *
   52: *> \param[in] JOB
   53: *> \verbatim
   54: *>          JOB is CHARACTER*1
   55: *>           = 'E':  compute eigenvalues only;
   56: *>           = 'S':  compute eigenvalues and the Schur form T.
   57: *> \endverbatim
   58: *>
   59: *> \param[in] COMPZ
   60: *> \verbatim
   61: *>          COMPZ is CHARACTER*1
   62: *>           = 'N':  no Schur vectors are computed;
   63: *>           = 'I':  Z is initialized to the unit matrix and the matrix Z
   64: *>                   of Schur vectors of H is returned;
   65: *>           = 'V':  Z must contain an unitary matrix Q on entry, and
   66: *>                   the product Q*Z is returned.
   67: *> \endverbatim
   68: *>
   69: *> \param[in] N
   70: *> \verbatim
   71: *>          N is INTEGER
   72: *>           The order of the matrix H.  N .GE. 0.
   73: *> \endverbatim
   74: *>
   75: *> \param[in] ILO
   76: *> \verbatim
   77: *>          ILO is INTEGER
   78: *> \endverbatim
   79: *>
   80: *> \param[in] IHI
   81: *> \verbatim
   82: *>          IHI is INTEGER
   83: *>
   84: *>           It is assumed that H is already upper triangular in rows
   85: *>           and columns 1:ILO-1 and IHI+1:N. ILO and IHI are normally
   86: *>           set by a previous call to ZGEBAL, and then passed to ZGEHRD
   87: *>           when the matrix output by ZGEBAL is reduced to Hessenberg
   88: *>           form. Otherwise ILO and IHI should be set to 1 and N
   89: *>           respectively.  If N.GT.0, then 1.LE.ILO.LE.IHI.LE.N.
   90: *>           If N = 0, then ILO = 1 and IHI = 0.
   91: *> \endverbatim
   92: *>
   93: *> \param[in,out] H
   94: *> \verbatim
   95: *>          H is COMPLEX*16 array, dimension (LDH,N)
   96: *>           On entry, the upper Hessenberg matrix H.
   97: *>           On exit, if INFO = 0 and JOB = 'S', H contains the upper
   98: *>           triangular matrix T from the Schur decomposition (the
   99: *>           Schur form). If INFO = 0 and JOB = 'E', the contents of
  100: *>           H are unspecified on exit.  (The output value of H when
  101: *>           INFO.GT.0 is given under the description of INFO below.)
  102: *>
  103: *>           Unlike earlier versions of ZHSEQR, this subroutine may
  104: *>           explicitly H(i,j) = 0 for i.GT.j and j = 1, 2, ... ILO-1
  105: *>           or j = IHI+1, IHI+2, ... N.
  106: *> \endverbatim
  107: *>
  108: *> \param[in] LDH
  109: *> \verbatim
  110: *>          LDH is INTEGER
  111: *>           The leading dimension of the array H. LDH .GE. max(1,N).
  112: *> \endverbatim
  113: *>
  114: *> \param[out] W
  115: *> \verbatim
  116: *>          W is COMPLEX*16 array, dimension (N)
  117: *>           The computed eigenvalues. If JOB = 'S', the eigenvalues are
  118: *>           stored in the same order as on the diagonal of the Schur
  119: *>           form returned in H, with W(i) = H(i,i).
  120: *> \endverbatim
  121: *>
  122: *> \param[in,out] Z
  123: *> \verbatim
  124: *>          Z is COMPLEX*16 array, dimension (LDZ,N)
  125: *>           If COMPZ = 'N', Z is not referenced.
  126: *>           If COMPZ = 'I', on entry Z need not be set and on exit,
  127: *>           if INFO = 0, Z contains the unitary matrix Z of the Schur
  128: *>           vectors of H.  If COMPZ = 'V', on entry Z must contain an
  129: *>           N-by-N matrix Q, which is assumed to be equal to the unit
  130: *>           matrix except for the submatrix Z(ILO:IHI,ILO:IHI). On exit,
  131: *>           if INFO = 0, Z contains Q*Z.
  132: *>           Normally Q is the unitary matrix generated by ZUNGHR
  133: *>           after the call to ZGEHRD which formed the Hessenberg matrix
  134: *>           H. (The output value of Z when INFO.GT.0 is given under
  135: *>           the description of INFO below.)
  136: *> \endverbatim
  137: *>
  138: *> \param[in] LDZ
  139: *> \verbatim
  140: *>          LDZ is INTEGER
  141: *>           The leading dimension of the array Z.  if COMPZ = 'I' or
  142: *>           COMPZ = 'V', then LDZ.GE.MAX(1,N).  Otherwize, LDZ.GE.1.
  143: *> \endverbatim
  144: *>
  145: *> \param[out] WORK
  146: *> \verbatim
  147: *>          WORK is COMPLEX*16 array, dimension (LWORK)
  148: *>           On exit, if INFO = 0, WORK(1) returns an estimate of
  149: *>           the optimal value for LWORK.
  150: *> \endverbatim
  151: *>
  152: *> \param[in] LWORK
  153: *> \verbatim
  154: *>          LWORK is INTEGER
  155: *>           The dimension of the array WORK.  LWORK .GE. max(1,N)
  156: *>           is sufficient and delivers very good and sometimes
  157: *>           optimal performance.  However, LWORK as large as 11*N
  158: *>           may be required for optimal performance.  A workspace
  159: *>           query is recommended to determine the optimal workspace
  160: *>           size.
  161: *>
  162: *>           If LWORK = -1, then ZHSEQR does a workspace query.
  163: *>           In this case, ZHSEQR checks the input parameters and
  164: *>           estimates the optimal workspace size for the given
  165: *>           values of N, ILO and IHI.  The estimate is returned
  166: *>           in WORK(1).  No error message related to LWORK is
  167: *>           issued by XERBLA.  Neither H nor Z are accessed.
  168: *> \endverbatim
  169: *>
  170: *> \param[out] INFO
  171: *> \verbatim
  172: *>          INFO is INTEGER
  173: *>             =  0:  successful exit
  174: *>           .LT. 0:  if INFO = -i, the i-th argument had an illegal
  175: *>                    value
  176: *>           .GT. 0:  if INFO = i, ZHSEQR failed to compute all of
  177: *>                the eigenvalues.  Elements 1:ilo-1 and i+1:n of WR
  178: *>                and WI contain those eigenvalues which have been
  179: *>                successfully computed.  (Failures are rare.)
  180: *>
  181: *>                If INFO .GT. 0 and JOB = 'E', then on exit, the
  182: *>                remaining unconverged eigenvalues are the eigen-
  183: *>                values of the upper Hessenberg matrix rows and
  184: *>                columns ILO through INFO of the final, output
  185: *>                value of H.
  186: *>
  187: *>                If INFO .GT. 0 and JOB   = 'S', then on exit
  188: *>
  189: *>           (*)  (initial value of H)*U  = U*(final value of H)
  190: *>
  191: *>                where U is a unitary matrix.  The final
  192: *>                value of  H is upper Hessenberg and triangular in
  193: *>                rows and columns INFO+1 through IHI.
  194: *>
  195: *>                If INFO .GT. 0 and COMPZ = 'V', then on exit
  196: *>
  197: *>                  (final value of Z)  =  (initial value of Z)*U
  198: *>
  199: *>                where U is the unitary matrix in (*) (regard-
  200: *>                less of the value of JOB.)
  201: *>
  202: *>                If INFO .GT. 0 and COMPZ = 'I', then on exit
  203: *>                      (final value of Z)  = U
  204: *>                where U is the unitary matrix in (*) (regard-
  205: *>                less of the value of JOB.)
  206: *>
  207: *>                If INFO .GT. 0 and COMPZ = 'N', then Z is not
  208: *>                accessed.
  209: *> \endverbatim
  210: *
  211: *  Authors:
  212: *  ========
  213: *
  214: *> \author Univ. of Tennessee 
  215: *> \author Univ. of California Berkeley 
  216: *> \author Univ. of Colorado Denver 
  217: *> \author NAG Ltd. 
  218: *
  219: *> \date November 2011
  220: *
  221: *> \ingroup complex16OTHERcomputational
  222: *
  223: *> \par Contributors:
  224: *  ==================
  225: *>
  226: *>       Karen Braman and Ralph Byers, Department of Mathematics,
  227: *>       University of Kansas, USA
  228: *
  229: *> \par Further Details:
  230: *  =====================
  231: *>
  232: *> \verbatim
  233: *>
  234: *>             Default values supplied by
  235: *>             ILAENV(ISPEC,'ZHSEQR',JOB(:1)//COMPZ(:1),N,ILO,IHI,LWORK).
  236: *>             It is suggested that these defaults be adjusted in order
  237: *>             to attain best performance in each particular
  238: *>             computational environment.
  239: *>
  240: *>            ISPEC=12: The ZLAHQR vs ZLAQR0 crossover point.
  241: *>                      Default: 75. (Must be at least 11.)
  242: *>
  243: *>            ISPEC=13: Recommended deflation window size.
  244: *>                      This depends on ILO, IHI and NS.  NS is the
  245: *>                      number of simultaneous shifts returned
  246: *>                      by ILAENV(ISPEC=15).  (See ISPEC=15 below.)
  247: *>                      The default for (IHI-ILO+1).LE.500 is NS.
  248: *>                      The default for (IHI-ILO+1).GT.500 is 3*NS/2.
  249: *>
  250: *>            ISPEC=14: Nibble crossover point. (See IPARMQ for
  251: *>                      details.)  Default: 14% of deflation window
  252: *>                      size.
  253: *>
  254: *>            ISPEC=15: Number of simultaneous shifts in a multishift
  255: *>                      QR iteration.
  256: *>
  257: *>                      If IHI-ILO+1 is ...
  258: *>
  259: *>                      greater than      ...but less    ... the
  260: *>                      or equal to ...      than        default is
  261: *>
  262: *>                           1               30          NS =   2(+)
  263: *>                          30               60          NS =   4(+)
  264: *>                          60              150          NS =  10(+)
  265: *>                         150              590          NS =  **
  266: *>                         590             3000          NS =  64
  267: *>                        3000             6000          NS = 128
  268: *>                        6000             infinity      NS = 256
  269: *>
  270: *>                  (+)  By default some or all matrices of this order
  271: *>                       are passed to the implicit double shift routine
  272: *>                       ZLAHQR and this parameter is ignored.  See
  273: *>                       ISPEC=12 above and comments in IPARMQ for
  274: *>                       details.
  275: *>
  276: *>                 (**)  The asterisks (**) indicate an ad-hoc
  277: *>                       function of N increasing from 10 to 64.
  278: *>
  279: *>            ISPEC=16: Select structured matrix multiply.
  280: *>                      If the number of simultaneous shifts (specified
  281: *>                      by ISPEC=15) is less than 14, then the default
  282: *>                      for ISPEC=16 is 0.  Otherwise the default for
  283: *>                      ISPEC=16 is 2.
  284: *> \endverbatim
  285: *
  286: *> \par References:
  287: *  ================
  288: *>
  289: *>       K. Braman, R. Byers and R. Mathias, The Multi-Shift QR
  290: *>       Algorithm Part I: Maintaining Well Focused Shifts, and Level 3
  291: *>       Performance, SIAM Journal of Matrix Analysis, volume 23, pages
  292: *>       929--947, 2002.
  293: *> \n
  294: *>       K. Braman, R. Byers and R. Mathias, The Multi-Shift QR
  295: *>       Algorithm Part II: Aggressive Early Deflation, SIAM Journal
  296: *>       of Matrix Analysis, volume 23, pages 948--973, 2002.
  297: *
  298: *  =====================================================================
  299:       SUBROUTINE ZHSEQR( JOB, COMPZ, N, ILO, IHI, H, LDH, W, Z, LDZ,
  300:      $                   WORK, LWORK, INFO )
  301: *
  302: *  -- LAPACK computational routine (version 3.4.0) --
  303: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
  304: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  305: *     November 2011
  306: *
  307: *     .. Scalar Arguments ..
  308:       INTEGER            IHI, ILO, INFO, LDH, LDZ, LWORK, N
  309:       CHARACTER          COMPZ, JOB
  310: *     ..
  311: *     .. Array Arguments ..
  312:       COMPLEX*16         H( LDH, * ), W( * ), WORK( * ), Z( LDZ, * )
  313: *     ..
  314: *
  315: *  =====================================================================
  316: *
  317: *     .. Parameters ..
  318: *
  319: *     ==== Matrices of order NTINY or smaller must be processed by
  320: *     .    ZLAHQR because of insufficient subdiagonal scratch space.
  321: *     .    (This is a hard limit.) ====
  322:       INTEGER            NTINY
  323:       PARAMETER          ( NTINY = 11 )
  324: *
  325: *     ==== NL allocates some local workspace to help small matrices
  326: *     .    through a rare ZLAHQR failure.  NL .GT. NTINY = 11 is
  327: *     .    required and NL .LE. NMIN = ILAENV(ISPEC=12,...) is recom-
  328: *     .    mended.  (The default value of NMIN is 75.)  Using NL = 49
  329: *     .    allows up to six simultaneous shifts and a 16-by-16
  330: *     .    deflation window.  ====
  331:       INTEGER            NL
  332:       PARAMETER          ( NL = 49 )
  333:       COMPLEX*16         ZERO, ONE
  334:       PARAMETER          ( ZERO = ( 0.0d0, 0.0d0 ),
  335:      $                   ONE = ( 1.0d0, 0.0d0 ) )
  336:       DOUBLE PRECISION   RZERO
  337:       PARAMETER          ( RZERO = 0.0d0 )
  338: *     ..
  339: *     .. Local Arrays ..
  340:       COMPLEX*16         HL( NL, NL ), WORKL( NL )
  341: *     ..
  342: *     .. Local Scalars ..
  343:       INTEGER            KBOT, NMIN
  344:       LOGICAL            INITZ, LQUERY, WANTT, WANTZ
  345: *     ..
  346: *     .. External Functions ..
  347:       INTEGER            ILAENV
  348:       LOGICAL            LSAME
  349:       EXTERNAL           ILAENV, LSAME
  350: *     ..
  351: *     .. External Subroutines ..
  352:       EXTERNAL           XERBLA, ZCOPY, ZLACPY, ZLAHQR, ZLAQR0, ZLASET
  353: *     ..
  354: *     .. Intrinsic Functions ..
  355:       INTRINSIC          DBLE, DCMPLX, MAX, MIN
  356: *     ..
  357: *     .. Executable Statements ..
  358: *
  359: *     ==== Decode and check the input parameters. ====
  360: *
  361:       WANTT = LSAME( JOB, 'S' )
  362:       INITZ = LSAME( COMPZ, 'I' )
  363:       WANTZ = INITZ .OR. LSAME( COMPZ, 'V' )
  364:       WORK( 1 ) = DCMPLX( DBLE( MAX( 1, N ) ), RZERO )
  365:       LQUERY = LWORK.EQ.-1
  366: *
  367:       INFO = 0
  368:       IF( .NOT.LSAME( JOB, 'E' ) .AND. .NOT.WANTT ) THEN
  369:          INFO = -1
  370:       ELSE IF( .NOT.LSAME( COMPZ, 'N' ) .AND. .NOT.WANTZ ) THEN
  371:          INFO = -2
  372:       ELSE IF( N.LT.0 ) THEN
  373:          INFO = -3
  374:       ELSE IF( ILO.LT.1 .OR. ILO.GT.MAX( 1, N ) ) THEN
  375:          INFO = -4
  376:       ELSE IF( IHI.LT.MIN( ILO, N ) .OR. IHI.GT.N ) THEN
  377:          INFO = -5
  378:       ELSE IF( LDH.LT.MAX( 1, N ) ) THEN
  379:          INFO = -7
  380:       ELSE IF( LDZ.LT.1 .OR. ( WANTZ .AND. LDZ.LT.MAX( 1, N ) ) ) THEN
  381:          INFO = -10
  382:       ELSE IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN
  383:          INFO = -12
  384:       END IF
  385: *
  386:       IF( INFO.NE.0 ) THEN
  387: *
  388: *        ==== Quick return in case of invalid argument. ====
  389: *
  390:          CALL XERBLA( 'ZHSEQR', -INFO )
  391:          RETURN
  392: *
  393:       ELSE IF( N.EQ.0 ) THEN
  394: *
  395: *        ==== Quick return in case N = 0; nothing to do. ====
  396: *
  397:          RETURN
  398: *
  399:       ELSE IF( LQUERY ) THEN
  400: *
  401: *        ==== Quick return in case of a workspace query ====
  402: *
  403:          CALL ZLAQR0( WANTT, WANTZ, N, ILO, IHI, H, LDH, W, ILO, IHI, Z,
  404:      $                LDZ, WORK, LWORK, INFO )
  405: *        ==== Ensure reported workspace size is backward-compatible with
  406: *        .    previous LAPACK versions. ====
  407:          WORK( 1 ) = DCMPLX( MAX( DBLE( WORK( 1 ) ), DBLE( MAX( 1,
  408:      $               N ) ) ), RZERO )
  409:          RETURN
  410: *
  411:       ELSE
  412: *
  413: *        ==== copy eigenvalues isolated by ZGEBAL ====
  414: *
  415:          IF( ILO.GT.1 )
  416:      $      CALL ZCOPY( ILO-1, H, LDH+1, W, 1 )
  417:          IF( IHI.LT.N )
  418:      $      CALL ZCOPY( N-IHI, H( IHI+1, IHI+1 ), LDH+1, W( IHI+1 ), 1 )
  419: *
  420: *        ==== Initialize Z, if requested ====
  421: *
  422:          IF( INITZ )
  423:      $      CALL ZLASET( 'A', N, N, ZERO, ONE, Z, LDZ )
  424: *
  425: *        ==== Quick return if possible ====
  426: *
  427:          IF( ILO.EQ.IHI ) THEN
  428:             W( ILO ) = H( ILO, ILO )
  429:             RETURN
  430:          END IF
  431: *
  432: *        ==== ZLAHQR/ZLAQR0 crossover point ====
  433: *
  434:          NMIN = ILAENV( 12, 'ZHSEQR', JOB( : 1 ) // COMPZ( : 1 ), N,
  435:      $          ILO, IHI, LWORK )
  436:          NMIN = MAX( NTINY, NMIN )
  437: *
  438: *        ==== ZLAQR0 for big matrices; ZLAHQR for small ones ====
  439: *
  440:          IF( N.GT.NMIN ) THEN
  441:             CALL ZLAQR0( WANTT, WANTZ, N, ILO, IHI, H, LDH, W, ILO, IHI,
  442:      $                   Z, LDZ, WORK, LWORK, INFO )
  443:          ELSE
  444: *
  445: *           ==== Small matrix ====
  446: *
  447:             CALL ZLAHQR( WANTT, WANTZ, N, ILO, IHI, H, LDH, W, ILO, IHI,
  448:      $                   Z, LDZ, INFO )
  449: *
  450:             IF( INFO.GT.0 ) THEN
  451: *
  452: *              ==== A rare ZLAHQR failure!  ZLAQR0 sometimes succeeds
  453: *              .    when ZLAHQR fails. ====
  454: *
  455:                KBOT = INFO
  456: *
  457:                IF( N.GE.NL ) THEN
  458: *
  459: *                 ==== Larger matrices have enough subdiagonal scratch
  460: *                 .    space to call ZLAQR0 directly. ====
  461: *
  462:                   CALL ZLAQR0( WANTT, WANTZ, N, ILO, KBOT, H, LDH, W,
  463:      $                         ILO, IHI, Z, LDZ, WORK, LWORK, INFO )
  464: *
  465:                ELSE
  466: *
  467: *                 ==== Tiny matrices don't have enough subdiagonal
  468: *                 .    scratch space to benefit from ZLAQR0.  Hence,
  469: *                 .    tiny matrices must be copied into a larger
  470: *                 .    array before calling ZLAQR0. ====
  471: *
  472:                   CALL ZLACPY( 'A', N, N, H, LDH, HL, NL )
  473:                   HL( N+1, N ) = ZERO
  474:                   CALL ZLASET( 'A', NL, NL-N, ZERO, ZERO, HL( 1, N+1 ),
  475:      $                         NL )
  476:                   CALL ZLAQR0( WANTT, WANTZ, NL, ILO, KBOT, HL, NL, W,
  477:      $                         ILO, IHI, Z, LDZ, WORKL, NL, INFO )
  478:                   IF( WANTT .OR. INFO.NE.0 )
  479:      $               CALL ZLACPY( 'A', N, N, HL, NL, H, LDH )
  480:                END IF
  481:             END IF
  482:          END IF
  483: *
  484: *        ==== Clear out the trash, if necessary. ====
  485: *
  486:          IF( ( WANTT .OR. INFO.NE.0 ) .AND. N.GT.2 )
  487:      $      CALL ZLASET( 'L', N-2, N-2, ZERO, ZERO, H( 3, 1 ), LDH )
  488: *
  489: *        ==== Ensure reported workspace size is backward-compatible with
  490: *        .    previous LAPACK versions. ====
  491: *
  492:          WORK( 1 ) = DCMPLX( MAX( DBLE( MAX( 1, N ) ),
  493:      $               DBLE( WORK( 1 ) ) ), RZERO )
  494:       END IF
  495: *
  496: *     ==== End of ZHSEQR ====
  497: *
  498:       END

CVSweb interface <joel.bertrand@systella.fr>