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