LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
zlaqr3.f
Go to the documentation of this file.
00001 *> \brief \b ZLAQR3
00002 *
00003 *  =========== DOCUMENTATION ===========
00004 *
00005 * Online html documentation available at 
00006 *            http://www.netlib.org/lapack/explore-html/ 
00007 *
00008 *> \htmlonly
00009 *> Download ZLAQR3 + dependencies 
00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zlaqr3.f"> 
00011 *> [TGZ]</a> 
00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zlaqr3.f"> 
00013 *> [ZIP]</a> 
00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zlaqr3.f"> 
00015 *> [TXT]</a>
00016 *> \endhtmlonly 
00017 *
00018 *  Definition:
00019 *  ===========
00020 *
00021 *       SUBROUTINE ZLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ,
00022 *                          IHIZ, Z, LDZ, NS, ND, SH, V, LDV, NH, T, LDT,
00023 *                          NV, WV, LDWV, WORK, LWORK )
00024 * 
00025 *       .. Scalar Arguments ..
00026 *       INTEGER            IHIZ, ILOZ, KBOT, KTOP, LDH, LDT, LDV, LDWV,
00027 *      $                   LDZ, LWORK, N, ND, NH, NS, NV, NW
00028 *       LOGICAL            WANTT, WANTZ
00029 *       ..
00030 *       .. Array Arguments ..
00031 *       COMPLEX*16         H( LDH, * ), SH( * ), T( LDT, * ), V( LDV, * ),
00032 *      $                   WORK( * ), WV( LDWV, * ), Z( LDZ, * )
00033 *       ..
00034 *  
00035 *
00036 *> \par Purpose:
00037 *  =============
00038 *>
00039 *> \verbatim
00040 *>
00041 *>    Aggressive early deflation:
00042 *>
00043 *>    ZLAQR3 accepts as input an upper Hessenberg matrix
00044 *>    H and performs an unitary similarity transformation
00045 *>    designed to detect and deflate fully converged eigenvalues from
00046 *>    a trailing principal submatrix.  On output H has been over-
00047 *>    written by a new Hessenberg matrix that is a perturbation of
00048 *>    an unitary similarity transformation of H.  It is to be
00049 *>    hoped that the final version of H has many zero subdiagonal
00050 *>    entries.
00051 *>
00052 *> \endverbatim
00053 *
00054 *  Arguments:
00055 *  ==========
00056 *
00057 *> \param[in] WANTT
00058 *> \verbatim
00059 *>          WANTT is LOGICAL
00060 *>          If .TRUE., then the Hessenberg matrix H is fully updated
00061 *>          so that the triangular Schur factor may be
00062 *>          computed (in cooperation with the calling subroutine).
00063 *>          If .FALSE., then only enough of H is updated to preserve
00064 *>          the eigenvalues.
00065 *> \endverbatim
00066 *>
00067 *> \param[in] WANTZ
00068 *> \verbatim
00069 *>          WANTZ is LOGICAL
00070 *>          If .TRUE., then the unitary matrix Z is updated so
00071 *>          so that the unitary Schur factor may be computed
00072 *>          (in cooperation with the calling subroutine).
00073 *>          If .FALSE., then Z is not referenced.
00074 *> \endverbatim
00075 *>
00076 *> \param[in] N
00077 *> \verbatim
00078 *>          N is INTEGER
00079 *>          The order of the matrix H and (if WANTZ is .TRUE.) the
00080 *>          order of the unitary matrix Z.
00081 *> \endverbatim
00082 *>
00083 *> \param[in] KTOP
00084 *> \verbatim
00085 *>          KTOP is INTEGER
00086 *>          It is assumed that either KTOP = 1 or H(KTOP,KTOP-1)=0.
00087 *>          KBOT and KTOP together determine an isolated block
00088 *>          along the diagonal of the Hessenberg matrix.
00089 *> \endverbatim
00090 *>
00091 *> \param[in] KBOT
00092 *> \verbatim
00093 *>          KBOT is INTEGER
00094 *>          It is assumed without a check that either
00095 *>          KBOT = N or H(KBOT+1,KBOT)=0.  KBOT and KTOP together
00096 *>          determine an isolated block along the diagonal of the
00097 *>          Hessenberg matrix.
00098 *> \endverbatim
00099 *>
00100 *> \param[in] NW
00101 *> \verbatim
00102 *>          NW is INTEGER
00103 *>          Deflation window size.  1 .LE. NW .LE. (KBOT-KTOP+1).
00104 *> \endverbatim
00105 *>
00106 *> \param[in,out] H
00107 *> \verbatim
00108 *>          H is COMPLEX*16 array, dimension (LDH,N)
00109 *>          On input the initial N-by-N section of H stores the
00110 *>          Hessenberg matrix undergoing aggressive early deflation.
00111 *>          On output H has been transformed by a unitary
00112 *>          similarity transformation, perturbed, and the returned
00113 *>          to Hessenberg form that (it is to be hoped) has some
00114 *>          zero subdiagonal entries.
00115 *> \endverbatim
00116 *>
00117 *> \param[in] LDH
00118 *> \verbatim
00119 *>          LDH is integer
00120 *>          Leading dimension of H just as declared in the calling
00121 *>          subroutine.  N .LE. LDH
00122 *> \endverbatim
00123 *>
00124 *> \param[in] ILOZ
00125 *> \verbatim
00126 *>          ILOZ is INTEGER
00127 *> \endverbatim
00128 *>
00129 *> \param[in] IHIZ
00130 *> \verbatim
00131 *>          IHIZ is INTEGER
00132 *>          Specify the rows of Z to which transformations must be
00133 *>          applied if WANTZ is .TRUE.. 1 .LE. ILOZ .LE. IHIZ .LE. N.
00134 *> \endverbatim
00135 *>
00136 *> \param[in,out] Z
00137 *> \verbatim
00138 *>          Z is COMPLEX*16 array, dimension (LDZ,N)
00139 *>          IF WANTZ is .TRUE., then on output, the unitary
00140 *>          similarity transformation mentioned above has been
00141 *>          accumulated into Z(ILOZ:IHIZ,ILO:IHI) from the right.
00142 *>          If WANTZ is .FALSE., then Z is unreferenced.
00143 *> \endverbatim
00144 *>
00145 *> \param[in] LDZ
00146 *> \verbatim
00147 *>          LDZ is integer
00148 *>          The leading dimension of Z just as declared in the
00149 *>          calling subroutine.  1 .LE. LDZ.
00150 *> \endverbatim
00151 *>
00152 *> \param[out] NS
00153 *> \verbatim
00154 *>          NS is integer
00155 *>          The number of unconverged (ie approximate) eigenvalues
00156 *>          returned in SR and SI that may be used as shifts by the
00157 *>          calling subroutine.
00158 *> \endverbatim
00159 *>
00160 *> \param[out] ND
00161 *> \verbatim
00162 *>          ND is integer
00163 *>          The number of converged eigenvalues uncovered by this
00164 *>          subroutine.
00165 *> \endverbatim
00166 *>
00167 *> \param[out] SH
00168 *> \verbatim
00169 *>          SH is COMPLEX*16 array, dimension KBOT
00170 *>          On output, approximate eigenvalues that may
00171 *>          be used for shifts are stored in SH(KBOT-ND-NS+1)
00172 *>          through SR(KBOT-ND).  Converged eigenvalues are
00173 *>          stored in SH(KBOT-ND+1) through SH(KBOT).
00174 *> \endverbatim
00175 *>
00176 *> \param[out] V
00177 *> \verbatim
00178 *>          V is COMPLEX*16 array, dimension (LDV,NW)
00179 *>          An NW-by-NW work array.
00180 *> \endverbatim
00181 *>
00182 *> \param[in] LDV
00183 *> \verbatim
00184 *>          LDV is integer scalar
00185 *>          The leading dimension of V just as declared in the
00186 *>          calling subroutine.  NW .LE. LDV
00187 *> \endverbatim
00188 *>
00189 *> \param[in] NH
00190 *> \verbatim
00191 *>          NH is integer scalar
00192 *>          The number of columns of T.  NH.GE.NW.
00193 *> \endverbatim
00194 *>
00195 *> \param[out] T
00196 *> \verbatim
00197 *>          T is COMPLEX*16 array, dimension (LDT,NW)
00198 *> \endverbatim
00199 *>
00200 *> \param[in] LDT
00201 *> \verbatim
00202 *>          LDT is integer
00203 *>          The leading dimension of T just as declared in the
00204 *>          calling subroutine.  NW .LE. LDT
00205 *> \endverbatim
00206 *>
00207 *> \param[in] NV
00208 *> \verbatim
00209 *>          NV is integer
00210 *>          The number of rows of work array WV available for
00211 *>          workspace.  NV.GE.NW.
00212 *> \endverbatim
00213 *>
00214 *> \param[out] WV
00215 *> \verbatim
00216 *>          WV is COMPLEX*16 array, dimension (LDWV,NW)
00217 *> \endverbatim
00218 *>
00219 *> \param[in] LDWV
00220 *> \verbatim
00221 *>          LDWV is integer
00222 *>          The leading dimension of W just as declared in the
00223 *>          calling subroutine.  NW .LE. LDV
00224 *> \endverbatim
00225 *>
00226 *> \param[out] WORK
00227 *> \verbatim
00228 *>          WORK is COMPLEX*16 array, dimension LWORK.
00229 *>          On exit, WORK(1) is set to an estimate of the optimal value
00230 *>          of LWORK for the given values of N, NW, KTOP and KBOT.
00231 *> \endverbatim
00232 *>
00233 *> \param[in] LWORK
00234 *> \verbatim
00235 *>          LWORK is integer
00236 *>          The dimension of the work array WORK.  LWORK = 2*NW
00237 *>          suffices, but greater efficiency may result from larger
00238 *>          values of LWORK.
00239 *>
00240 *>          If LWORK = -1, then a workspace query is assumed; ZLAQR3
00241 *>          only estimates the optimal workspace size for the given
00242 *>          values of N, NW, KTOP and KBOT.  The estimate is returned
00243 *>          in WORK(1).  No error message related to LWORK is issued
00244 *>          by XERBLA.  Neither H nor Z are accessed.
00245 *> \endverbatim
00246 *
00247 *  Authors:
00248 *  ========
00249 *
00250 *> \author Univ. of Tennessee 
00251 *> \author Univ. of California Berkeley 
00252 *> \author Univ. of Colorado Denver 
00253 *> \author NAG Ltd. 
00254 *
00255 *> \date November 2011
00256 *
00257 *> \ingroup complex16OTHERauxiliary
00258 *
00259 *> \par Contributors:
00260 *  ==================
00261 *>
00262 *>       Karen Braman and Ralph Byers, Department of Mathematics,
00263 *>       University of Kansas, USA
00264 *>
00265 *  =====================================================================
00266       SUBROUTINE ZLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ,
00267      $                   IHIZ, Z, LDZ, NS, ND, SH, V, LDV, NH, T, LDT,
00268      $                   NV, WV, LDWV, WORK, LWORK )
00269 *
00270 *  -- LAPACK auxiliary routine (version 3.4.0) --
00271 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00272 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00273 *     November 2011
00274 *
00275 *     .. Scalar Arguments ..
00276       INTEGER            IHIZ, ILOZ, KBOT, KTOP, LDH, LDT, LDV, LDWV,
00277      $                   LDZ, LWORK, N, ND, NH, NS, NV, NW
00278       LOGICAL            WANTT, WANTZ
00279 *     ..
00280 *     .. Array Arguments ..
00281       COMPLEX*16         H( LDH, * ), SH( * ), T( LDT, * ), V( LDV, * ),
00282      $                   WORK( * ), WV( LDWV, * ), Z( LDZ, * )
00283 *     ..
00284 *
00285 *  ================================================================
00286 *
00287 *     .. Parameters ..
00288       COMPLEX*16         ZERO, ONE
00289       PARAMETER          ( ZERO = ( 0.0d0, 0.0d0 ),
00290      $                   ONE = ( 1.0d0, 0.0d0 ) )
00291       DOUBLE PRECISION   RZERO, RONE
00292       PARAMETER          ( RZERO = 0.0d0, RONE = 1.0d0 )
00293 *     ..
00294 *     .. Local Scalars ..
00295       COMPLEX*16         BETA, CDUM, S, TAU
00296       DOUBLE PRECISION   FOO, SAFMAX, SAFMIN, SMLNUM, ULP
00297       INTEGER            I, IFST, ILST, INFO, INFQR, J, JW, KCOL, KLN,
00298      $                   KNT, KROW, KWTOP, LTOP, LWK1, LWK2, LWK3,
00299      $                   LWKOPT, NMIN
00300 *     ..
00301 *     .. External Functions ..
00302       DOUBLE PRECISION   DLAMCH
00303       INTEGER            ILAENV
00304       EXTERNAL           DLAMCH, ILAENV
00305 *     ..
00306 *     .. External Subroutines ..
00307       EXTERNAL           DLABAD, ZCOPY, ZGEHRD, ZGEMM, ZLACPY, ZLAHQR,
00308      $                   ZLAQR4, ZLARF, ZLARFG, ZLASET, ZTREXC, ZUNMHR
00309 *     ..
00310 *     .. Intrinsic Functions ..
00311       INTRINSIC          ABS, DBLE, DCMPLX, DCONJG, DIMAG, INT, MAX, MIN
00312 *     ..
00313 *     .. Statement Functions ..
00314       DOUBLE PRECISION   CABS1
00315 *     ..
00316 *     .. Statement Function definitions ..
00317       CABS1( CDUM ) = ABS( DBLE( CDUM ) ) + ABS( DIMAG( CDUM ) )
00318 *     ..
00319 *     .. Executable Statements ..
00320 *
00321 *     ==== Estimate optimal workspace. ====
00322 *
00323       JW = MIN( NW, KBOT-KTOP+1 )
00324       IF( JW.LE.2 ) THEN
00325          LWKOPT = 1
00326       ELSE
00327 *
00328 *        ==== Workspace query call to ZGEHRD ====
00329 *
00330          CALL ZGEHRD( JW, 1, JW-1, T, LDT, WORK, WORK, -1, INFO )
00331          LWK1 = INT( WORK( 1 ) )
00332 *
00333 *        ==== Workspace query call to ZUNMHR ====
00334 *
00335          CALL ZUNMHR( 'R', 'N', JW, JW, 1, JW-1, T, LDT, WORK, V, LDV,
00336      $                WORK, -1, INFO )
00337          LWK2 = INT( WORK( 1 ) )
00338 *
00339 *        ==== Workspace query call to ZLAQR4 ====
00340 *
00341          CALL ZLAQR4( .true., .true., JW, 1, JW, T, LDT, SH, 1, JW, V,
00342      $                LDV, WORK, -1, INFQR )
00343          LWK3 = INT( WORK( 1 ) )
00344 *
00345 *        ==== Optimal workspace ====
00346 *
00347          LWKOPT = MAX( JW+MAX( LWK1, LWK2 ), LWK3 )
00348       END IF
00349 *
00350 *     ==== Quick return in case of workspace query. ====
00351 *
00352       IF( LWORK.EQ.-1 ) THEN
00353          WORK( 1 ) = DCMPLX( LWKOPT, 0 )
00354          RETURN
00355       END IF
00356 *
00357 *     ==== Nothing to do ...
00358 *     ... for an empty active block ... ====
00359       NS = 0
00360       ND = 0
00361       WORK( 1 ) = ONE
00362       IF( KTOP.GT.KBOT )
00363      $   RETURN
00364 *     ... nor for an empty deflation window. ====
00365       IF( NW.LT.1 )
00366      $   RETURN
00367 *
00368 *     ==== Machine constants ====
00369 *
00370       SAFMIN = DLAMCH( 'SAFE MINIMUM' )
00371       SAFMAX = RONE / SAFMIN
00372       CALL DLABAD( SAFMIN, SAFMAX )
00373       ULP = DLAMCH( 'PRECISION' )
00374       SMLNUM = SAFMIN*( DBLE( N ) / ULP )
00375 *
00376 *     ==== Setup deflation window ====
00377 *
00378       JW = MIN( NW, KBOT-KTOP+1 )
00379       KWTOP = KBOT - JW + 1
00380       IF( KWTOP.EQ.KTOP ) THEN
00381          S = ZERO
00382       ELSE
00383          S = H( KWTOP, KWTOP-1 )
00384       END IF
00385 *
00386       IF( KBOT.EQ.KWTOP ) THEN
00387 *
00388 *        ==== 1-by-1 deflation window: not much to do ====
00389 *
00390          SH( KWTOP ) = H( KWTOP, KWTOP )
00391          NS = 1
00392          ND = 0
00393          IF( CABS1( S ).LE.MAX( SMLNUM, ULP*CABS1( H( KWTOP,
00394      $       KWTOP ) ) ) ) THEN
00395             NS = 0
00396             ND = 1
00397             IF( KWTOP.GT.KTOP )
00398      $         H( KWTOP, KWTOP-1 ) = ZERO
00399          END IF
00400          WORK( 1 ) = ONE
00401          RETURN
00402       END IF
00403 *
00404 *     ==== Convert to spike-triangular form.  (In case of a
00405 *     .    rare QR failure, this routine continues to do
00406 *     .    aggressive early deflation using that part of
00407 *     .    the deflation window that converged using INFQR
00408 *     .    here and there to keep track.) ====
00409 *
00410       CALL ZLACPY( 'U', JW, JW, H( KWTOP, KWTOP ), LDH, T, LDT )
00411       CALL ZCOPY( JW-1, H( KWTOP+1, KWTOP ), LDH+1, T( 2, 1 ), LDT+1 )
00412 *
00413       CALL ZLASET( 'A', JW, JW, ZERO, ONE, V, LDV )
00414       NMIN = ILAENV( 12, 'ZLAQR3', 'SV', JW, 1, JW, LWORK )
00415       IF( JW.GT.NMIN ) THEN
00416          CALL ZLAQR4( .true., .true., JW, 1, JW, T, LDT, SH( KWTOP ), 1,
00417      $                JW, V, LDV, WORK, LWORK, INFQR )
00418       ELSE
00419          CALL ZLAHQR( .true., .true., JW, 1, JW, T, LDT, SH( KWTOP ), 1,
00420      $                JW, V, LDV, INFQR )
00421       END IF
00422 *
00423 *     ==== Deflation detection loop ====
00424 *
00425       NS = JW
00426       ILST = INFQR + 1
00427       DO 10 KNT = INFQR + 1, JW
00428 *
00429 *        ==== Small spike tip deflation test ====
00430 *
00431          FOO = CABS1( T( NS, NS ) )
00432          IF( FOO.EQ.RZERO )
00433      $      FOO = CABS1( S )
00434          IF( CABS1( S )*CABS1( V( 1, NS ) ).LE.MAX( SMLNUM, ULP*FOO ) )
00435      $        THEN
00436 *
00437 *           ==== One more converged eigenvalue ====
00438 *
00439             NS = NS - 1
00440          ELSE
00441 *
00442 *           ==== One undeflatable eigenvalue.  Move it up out of the
00443 *           .    way.   (ZTREXC can not fail in this case.) ====
00444 *
00445             IFST = NS
00446             CALL ZTREXC( 'V', JW, T, LDT, V, LDV, IFST, ILST, INFO )
00447             ILST = ILST + 1
00448          END IF
00449    10 CONTINUE
00450 *
00451 *        ==== Return to Hessenberg form ====
00452 *
00453       IF( NS.EQ.0 )
00454      $   S = ZERO
00455 *
00456       IF( NS.LT.JW ) THEN
00457 *
00458 *        ==== sorting the diagonal of T improves accuracy for
00459 *        .    graded matrices.  ====
00460 *
00461          DO 30 I = INFQR + 1, NS
00462             IFST = I
00463             DO 20 J = I + 1, NS
00464                IF( CABS1( T( J, J ) ).GT.CABS1( T( IFST, IFST ) ) )
00465      $            IFST = J
00466    20       CONTINUE
00467             ILST = I
00468             IF( IFST.NE.ILST )
00469      $         CALL ZTREXC( 'V', JW, T, LDT, V, LDV, IFST, ILST, INFO )
00470    30    CONTINUE
00471       END IF
00472 *
00473 *     ==== Restore shift/eigenvalue array from T ====
00474 *
00475       DO 40 I = INFQR + 1, JW
00476          SH( KWTOP+I-1 ) = T( I, I )
00477    40 CONTINUE
00478 *
00479 *
00480       IF( NS.LT.JW .OR. S.EQ.ZERO ) THEN
00481          IF( NS.GT.1 .AND. S.NE.ZERO ) THEN
00482 *
00483 *           ==== Reflect spike back into lower triangle ====
00484 *
00485             CALL ZCOPY( NS, V, LDV, WORK, 1 )
00486             DO 50 I = 1, NS
00487                WORK( I ) = DCONJG( WORK( I ) )
00488    50       CONTINUE
00489             BETA = WORK( 1 )
00490             CALL ZLARFG( NS, BETA, WORK( 2 ), 1, TAU )
00491             WORK( 1 ) = ONE
00492 *
00493             CALL ZLASET( 'L', JW-2, JW-2, ZERO, ZERO, T( 3, 1 ), LDT )
00494 *
00495             CALL ZLARF( 'L', NS, JW, WORK, 1, DCONJG( TAU ), T, LDT,
00496      $                  WORK( JW+1 ) )
00497             CALL ZLARF( 'R', NS, NS, WORK, 1, TAU, T, LDT,
00498      $                  WORK( JW+1 ) )
00499             CALL ZLARF( 'R', JW, NS, WORK, 1, TAU, V, LDV,
00500      $                  WORK( JW+1 ) )
00501 *
00502             CALL ZGEHRD( JW, 1, NS, T, LDT, WORK, WORK( JW+1 ),
00503      $                   LWORK-JW, INFO )
00504          END IF
00505 *
00506 *        ==== Copy updated reduced window into place ====
00507 *
00508          IF( KWTOP.GT.1 )
00509      $      H( KWTOP, KWTOP-1 ) = S*DCONJG( V( 1, 1 ) )
00510          CALL ZLACPY( 'U', JW, JW, T, LDT, H( KWTOP, KWTOP ), LDH )
00511          CALL ZCOPY( JW-1, T( 2, 1 ), LDT+1, H( KWTOP+1, KWTOP ),
00512      $               LDH+1 )
00513 *
00514 *        ==== Accumulate orthogonal matrix in order update
00515 *        .    H and Z, if requested.  ====
00516 *
00517          IF( NS.GT.1 .AND. S.NE.ZERO )
00518      $      CALL ZUNMHR( 'R', 'N', JW, NS, 1, NS, T, LDT, WORK, V, LDV,
00519      $                   WORK( JW+1 ), LWORK-JW, INFO )
00520 *
00521 *        ==== Update vertical slab in H ====
00522 *
00523          IF( WANTT ) THEN
00524             LTOP = 1
00525          ELSE
00526             LTOP = KTOP
00527          END IF
00528          DO 60 KROW = LTOP, KWTOP - 1, NV
00529             KLN = MIN( NV, KWTOP-KROW )
00530             CALL ZGEMM( 'N', 'N', KLN, JW, JW, ONE, H( KROW, KWTOP ),
00531      $                  LDH, V, LDV, ZERO, WV, LDWV )
00532             CALL ZLACPY( 'A', KLN, JW, WV, LDWV, H( KROW, KWTOP ), LDH )
00533    60    CONTINUE
00534 *
00535 *        ==== Update horizontal slab in H ====
00536 *
00537          IF( WANTT ) THEN
00538             DO 70 KCOL = KBOT + 1, N, NH
00539                KLN = MIN( NH, N-KCOL+1 )
00540                CALL ZGEMM( 'C', 'N', JW, KLN, JW, ONE, V, LDV,
00541      $                     H( KWTOP, KCOL ), LDH, ZERO, T, LDT )
00542                CALL ZLACPY( 'A', JW, KLN, T, LDT, H( KWTOP, KCOL ),
00543      $                      LDH )
00544    70       CONTINUE
00545          END IF
00546 *
00547 *        ==== Update vertical slab in Z ====
00548 *
00549          IF( WANTZ ) THEN
00550             DO 80 KROW = ILOZ, IHIZ, NV
00551                KLN = MIN( NV, IHIZ-KROW+1 )
00552                CALL ZGEMM( 'N', 'N', KLN, JW, JW, ONE, Z( KROW, KWTOP ),
00553      $                     LDZ, V, LDV, ZERO, WV, LDWV )
00554                CALL ZLACPY( 'A', KLN, JW, WV, LDWV, Z( KROW, KWTOP ),
00555      $                      LDZ )
00556    80       CONTINUE
00557          END IF
00558       END IF
00559 *
00560 *     ==== Return the number of deflations ... ====
00561 *
00562       ND = JW - NS
00563 *
00564 *     ==== ... and the number of shifts. (Subtracting
00565 *     .    INFQR from the spike length takes care
00566 *     .    of the case of a rare QR failure while
00567 *     .    calculating eigenvalues of the deflation
00568 *     .    window.)  ====
00569 *
00570       NS = NS - INFQR
00571 *
00572 *      ==== Return optimal workspace. ====
00573 *
00574       WORK( 1 ) = DCMPLX( LWKOPT, 0 )
00575 *
00576 *     ==== End of ZLAQR3 ====
00577 *
00578       END
 All Files Functions