SRC/claqr3.f

   1 *> \brief \b CLAQR3 performs the unitary similarity transformation of a Hessenberg matrix to detect and deflate fully converged eigenvalues from a trailing principal submatrix (aggressive early deflation).
   2 *
   3 *  =========== DOCUMENTATION ===========
   4 *
   5 * Online html documentation available at
   6 *            http://www.netlib.org/lapack/explore-html/
   7 *
   8 *> \htmlonly
   9 *> Download CLAQR3 + dependencies
  10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/claqr3.f">
  11 *> [TGZ]</a>
  12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/claqr3.f">
  13 *> [ZIP]</a>
  14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/claqr3.f">
  15 *> [TXT]</a>
  16 *> \endhtmlonly
  17 *
  18 *  Definition:
  19 *  ===========
  20 *
  21 *       SUBROUTINE CLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ,
  22 *                          IHIZ, Z, LDZ, NS, ND, SH, V, LDV, NH, T, LDT,
  23 *                          NV, WV, LDWV, WORK, LWORK )
  24 *
  25 *       .. Scalar Arguments ..
  26 *       INTEGER            IHIZ, ILOZ, KBOT, KTOP, LDH, LDT, LDV, LDWV,
  27 *      $                   LDZ, LWORK, N, ND, NH, NS, NV, NW
  28 *       LOGICAL            WANTT, WANTZ
  29 *       ..
  30 *       .. Array Arguments ..
  31 *       COMPLEX            H( LDH, * ), SH( * ), T( LDT, * ), V( LDV, * ),
  32 *      $                   WORK( * ), WV( LDWV, * ), Z( LDZ, * )
  33 *       ..
  34 *
  35 *
  36 *> \par Purpose:
  37 *  =============
  38 *>
  39 *> \verbatim
  40 *>
  41 *>    Aggressive early deflation:
  42 *>
  43 *>    CLAQR3 accepts as input an upper Hessenberg matrix
  44 *>    H and performs an unitary similarity transformation
  45 *>    designed to detect and deflate fully converged eigenvalues from
  46 *>    a trailing principal submatrix.  On output H has been over-
  47 *>    written by a new Hessenberg matrix that is a perturbation of
  48 *>    an unitary similarity transformation of H.  It is to be
  49 *>    hoped that the final version of H has many zero subdiagonal
  50 *>    entries.
  51 *> \endverbatim
  52 *
  53 *  Arguments:
  54 *  ==========
  55 *
  56 *> \param[in] WANTT
  57 *> \verbatim
  58 *>          WANTT is LOGICAL
  59 *>          If .TRUE., then the Hessenberg matrix H is fully updated
  60 *>          so that the triangular Schur factor may be
  61 *>          computed (in cooperation with the calling subroutine).
  62 *>          If .FALSE., then only enough of H is updated to preserve
  63 *>          the eigenvalues.
  64 *> \endverbatim
  65 *>
  66 *> \param[in] WANTZ
  67 *> \verbatim
  68 *>          WANTZ is LOGICAL
  69 *>          If .TRUE., then the unitary matrix Z is updated so
  70 *>          so that the unitary Schur factor may be computed
  71 *>          (in cooperation with the calling subroutine).
  72 *>          If .FALSE., then Z is not referenced.
  73 *> \endverbatim
  74 *>
  75 *> \param[in] N
  76 *> \verbatim
  77 *>          N is INTEGER
  78 *>          The order of the matrix H and (if WANTZ is .TRUE.) the
  79 *>          order of the unitary matrix Z.
  80 *> \endverbatim
  81 *>
  82 *> \param[in] KTOP
  83 *> \verbatim
  84 *>          KTOP is INTEGER
  85 *>          It is assumed that either KTOP = 1 or H(KTOP,KTOP-1)=0.
  86 *>          KBOT and KTOP together determine an isolated block
  87 *>          along the diagonal of the Hessenberg matrix.
  88 *> \endverbatim
  89 *>
  90 *> \param[in] KBOT
  91 *> \verbatim
  92 *>          KBOT is INTEGER
  93 *>          It is assumed without a check that either
  94 *>          KBOT = N or H(KBOT+1,KBOT)=0.  KBOT and KTOP together
  95 *>          determine an isolated block along the diagonal of the
  96 *>          Hessenberg matrix.
  97 *> \endverbatim
  98 *>
  99 *> \param[in] NW
 100 *> \verbatim
 101 *>          NW is INTEGER
 102 *>          Deflation window size.  1 .LE. NW .LE. (KBOT-KTOP+1).
 103 *> \endverbatim
 104 *>
 105 *> \param[in,out] H
 106 *> \verbatim
 107 *>          H is COMPLEX array, dimension (LDH,N)
 108 *>          On input the initial N-by-N section of H stores the
 109 *>          Hessenberg matrix undergoing aggressive early deflation.
 110 *>          On output H has been transformed by a unitary
 111 *>          similarity transformation, perturbed, and the returned
 112 *>          to Hessenberg form that (it is to be hoped) has some
 113 *>          zero subdiagonal entries.
 114 *> \endverbatim
 115 *>
 116 *> \param[in] LDH
 117 *> \verbatim
 118 *>          LDH is integer
 119 *>          Leading dimension of H just as declared in the calling
 120 *>          subroutine.  N .LE. LDH
 121 *> \endverbatim
 122 *>
 123 *> \param[in] ILOZ
 124 *> \verbatim
 125 *>          ILOZ is INTEGER
 126 *> \endverbatim
 127 *>
 128 *> \param[in] IHIZ
 129 *> \verbatim
 130 *>          IHIZ is INTEGER
 131 *>          Specify the rows of Z to which transformations must be
 132 *>          applied if WANTZ is .TRUE.. 1 .LE. ILOZ .LE. IHIZ .LE. N.
 133 *> \endverbatim
 134 *>
 135 *> \param[in,out] Z
 136 *> \verbatim
 137 *>          Z is COMPLEX array, dimension (LDZ,N)
 138 *>          IF WANTZ is .TRUE., then on output, the unitary
 139 *>          similarity transformation mentioned above has been
 140 *>          accumulated into Z(ILOZ:IHIZ,ILOZ:IHIZ) from the right.
 141 *>          If WANTZ is .FALSE., then Z is unreferenced.
 142 *> \endverbatim
 143 *>
 144 *> \param[in] LDZ
 145 *> \verbatim
 146 *>          LDZ is integer
 147 *>          The leading dimension of Z just as declared in the
 148 *>          calling subroutine.  1 .LE. LDZ.
 149 *> \endverbatim
 150 *>
 151 *> \param[out] NS
 152 *> \verbatim
 153 *>          NS is integer
 154 *>          The number of unconverged (ie approximate) eigenvalues
 155 *>          returned in SR and SI that may be used as shifts by the
 156 *>          calling subroutine.
 157 *> \endverbatim
 158 *>
 159 *> \param[out] ND
 160 *> \verbatim
 161 *>          ND is integer
 162 *>          The number of converged eigenvalues uncovered by this
 163 *>          subroutine.
 164 *> \endverbatim
 165 *>
 166 *> \param[out] SH
 167 *> \verbatim
 168 *>          SH is COMPLEX array, dimension KBOT
 169 *>          On output, approximate eigenvalues that may
 170 *>          be used for shifts are stored in SH(KBOT-ND-NS+1)
 171 *>          through SR(KBOT-ND).  Converged eigenvalues are
 172 *>          stored in SH(KBOT-ND+1) through SH(KBOT).
 173 *> \endverbatim
 174 *>
 175 *> \param[out] V
 176 *> \verbatim
 177 *>          V is COMPLEX array, dimension (LDV,NW)
 178 *>          An NW-by-NW work array.
 179 *> \endverbatim
 180 *>
 181 *> \param[in] LDV
 182 *> \verbatim
 183 *>          LDV is integer scalar
 184 *>          The leading dimension of V just as declared in the
 185 *>          calling subroutine.  NW .LE. LDV
 186 *> \endverbatim
 187 *>
 188 *> \param[in] NH
 189 *> \verbatim
 190 *>          NH is integer scalar
 191 *>          The number of columns of T.  NH.GE.NW.
 192 *> \endverbatim
 193 *>
 194 *> \param[out] T
 195 *> \verbatim
 196 *>          T is COMPLEX array, dimension (LDT,NW)
 197 *> \endverbatim
 198 *>
 199 *> \param[in] LDT
 200 *> \verbatim
 201 *>          LDT is integer
 202 *>          The leading dimension of T just as declared in the
 203 *>          calling subroutine.  NW .LE. LDT
 204 *> \endverbatim
 205 *>
 206 *> \param[in] NV
 207 *> \verbatim
 208 *>          NV is integer
 209 *>          The number of rows of work array WV available for
 210 *>          workspace.  NV.GE.NW.
 211 *> \endverbatim
 212 *>
 213 *> \param[out] WV
 214 *> \verbatim
 215 *>          WV is COMPLEX array, dimension (LDWV,NW)
 216 *> \endverbatim
 217 *>
 218 *> \param[in] LDWV
 219 *> \verbatim
 220 *>          LDWV is integer
 221 *>          The leading dimension of W just as declared in the
 222 *>          calling subroutine.  NW .LE. LDV
 223 *> \endverbatim
 224 *>
 225 *> \param[out] WORK
 226 *> \verbatim
 227 *>          WORK is COMPLEX array, dimension LWORK.
 228 *>          On exit, WORK(1) is set to an estimate of the optimal value
 229 *>          of LWORK for the given values of N, NW, KTOP and KBOT.
 230 *> \endverbatim
 231 *>
 232 *> \param[in] LWORK
 233 *> \verbatim
 234 *>          LWORK is integer
 235 *>          The dimension of the work array WORK.  LWORK = 2*NW
 236 *>          suffices, but greater efficiency may result from larger
 237 *>          values of LWORK.
 238 *>
 239 *>          If LWORK = -1, then a workspace query is assumed; CLAQR3
 240 *>          only estimates the optimal workspace size for the given
 241 *>          values of N, NW, KTOP and KBOT.  The estimate is returned
 242 *>          in WORK(1).  No error message related to LWORK is issued
 243 *>          by XERBLA.  Neither H nor Z are accessed.
 244 *> \endverbatim
 245 *
 246 *  Authors:
 247 *  ========
 248 *
 249 *> \author Univ. of Tennessee
 250 *> \author Univ. of California Berkeley
 251 *> \author Univ. of Colorado Denver
 252 *> \author NAG Ltd.
 253 *
 254 *> \date June 2016
 255 *
 256 *> \ingroup complexOTHERauxiliary
 257 *
 258 *> \par Contributors:
 259 *  ==================
 260 *>
 261 *>       Karen Braman and Ralph Byers, Department of Mathematics,
 262 *>       University of Kansas, USA
 263 *>
 264 *  =====================================================================
 265       SUBROUTINE CLAQR3( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ,
 266      $                   IHIZ, Z, LDZ, NS, ND, SH, V, LDV, NH, T, LDT,
 267      $                   NV, WV, LDWV, WORK, LWORK )
 268 *
 269 *  -- LAPACK auxiliary routine (version 3.6.1) --
 270 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 271 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 272 *     June 2016
 273 *
 274 *     .. Scalar Arguments ..
 275       INTEGER            IHIZ, ILOZ, KBOT, KTOP, LDH, LDT, LDV, LDWV,
 276      $                   LDZ, LWORK, N, ND, NH, NS, NV, NW
 277       LOGICAL            WANTT, WANTZ
 278 *     ..
 279 *     .. Array Arguments ..
 280       COMPLEX            H( LDH, * ), SH( * ), T( LDT, * ), V( LDV, * ),
 281      $                   WORK( * ), WV( LDWV, * ), Z( LDZ, * )
 282 *     ..
 283 *
 284 *  ================================================================
 285 *
 286 *     .. Parameters ..
 287       COMPLEX            ZERO, ONE
 288       PARAMETER          ( ZERO = ( 0.0e0, 0.0e0 ),
 289      $                   ONE = ( 1.0e0, 0.0e0 ) )
 290       REAL               RZERO, RONE
 291       PARAMETER          ( RZERO = 0.0e0, RONE = 1.0e0 )
 292 *     ..
 293 *     .. Local Scalars ..
 294       COMPLEX            BETA, CDUM, S, TAU
 295       REAL               FOO, SAFMAX, SAFMIN, SMLNUM, ULP
 296       INTEGER            I, IFST, ILST, INFO, INFQR, J, JW, KCOL, KLN,
 297      $                   KNT, KROW, KWTOP, LTOP, LWK1, LWK2, LWK3,
 298      $                   LWKOPT, NMIN
 299 *     ..
 300 *     .. External Functions ..
 301       REAL               SLAMCH
 302       INTEGER            ILAENV
 303       EXTERNAL           SLAMCH, ILAENV
 304 *     ..
 305 *     .. External Subroutines ..
 306       EXTERNAL           CCOPY, CGEHRD, CGEMM, CLACPY, CLAHQR, CLAQR4,
 307      $                   CLARF, CLARFG, CLASET, CTREXC, CUNMHR, SLABAD
 308 *     ..
 309 *     .. Intrinsic Functions ..
 310       INTRINSIC          ABS, AIMAG, CMPLX, CONJG, INT, MAX, MIN, REAL
 311 *     ..
 312 *     .. Statement Functions ..
 313       REAL               CABS1
 314 *     ..
 315 *     .. Statement Function definitions ..
 316       CABS1( CDUM ) = ABS( REAL( CDUM ) ) + ABS( AIMAG( CDUM ) )
 317 *     ..
 318 *     .. Executable Statements ..
 319 *
 320 *     ==== Estimate optimal workspace. ====
 321 *
 322       JW = MIN( NW, KBOT-KTOP+1 )
 323       IF( JW.LE.2 ) THEN
 324          LWKOPT = 1
 325       ELSE
 326 *
 327 *        ==== Workspace query call to CGEHRD ====
 328 *
 329          CALL CGEHRD( JW, 1, JW-1, T, LDT, WORK, WORK, -1, INFO )
 330          LWK1 = INT( WORK( 1 ) )
 331 *
 332 *        ==== Workspace query call to CUNMHR ====
 333 *
 334          CALL CUNMHR( 'R', 'N', JW, JW, 1, JW-1, T, LDT, WORK, V, LDV,
 335      $                WORK, -1, INFO )
 336          LWK2 = INT( WORK( 1 ) )
 337 *
 338 *        ==== Workspace query call to CLAQR4 ====
 339 *
 340          CALL CLAQR4( .true., .true., JW, 1, JW, T, LDT, SH, 1, JW, V,
 341      $                LDV, WORK, -1, INFQR )
 342          LWK3 = INT( WORK( 1 ) )
 343 *
 344 *        ==== Optimal workspace ====
 345 *
 346          LWKOPT = MAX( JW+MAX( LWK1, LWK2 ), LWK3 )
 347       END IF
 348 *
 349 *     ==== Quick return in case of workspace query. ====
 350 *
 351       IF( LWORK.EQ.-1 ) THEN
 352          WORK( 1 ) = CMPLX( LWKOPT, 0 )
 353          RETURN
 354       END IF
 355 *
 356 *     ==== Nothing to do ...
 357 *     ... for an empty active block ... ====
 358       NS = 0
 359       ND = 0
 360       WORK( 1 ) = ONE
 361       IF( KTOP.GT.KBOT )
 362      $   RETURN
 363 *     ... nor for an empty deflation window. ====
 364       IF( NW.LT.1 )
 365      $   RETURN
 366 *
 367 *     ==== Machine constants ====
 368 *
 369       SAFMIN = SLAMCH( 'SAFE MINIMUM' )
 370       SAFMAX = RONE / SAFMIN
 371       CALL SLABAD( SAFMIN, SAFMAX )
 372       ULP = SLAMCH( 'PRECISION' )
 373       SMLNUM = SAFMIN*( REAL( N ) / ULP )
 374 *
 375 *     ==== Setup deflation window ====
 376 *
 377       JW = MIN( NW, KBOT-KTOP+1 )
 378       KWTOP = KBOT - JW + 1
 379       IF( KWTOP.EQ.KTOP ) THEN
 380          S = ZERO
 381       ELSE
 382          S = H( KWTOP, KWTOP-1 )
 383       END IF
 384 *
 385       IF( KBOT.EQ.KWTOP ) THEN
 386 *
 387 *        ==== 1-by-1 deflation window: not much to do ====
 388 *
 389          SH( KWTOP ) = H( KWTOP, KWTOP )
 390          NS = 1
 391          ND = 0
 392          IF( CABS1( S ).LE.MAX( SMLNUM, ULP*CABS1( H( KWTOP,
 393      $       KWTOP ) ) ) ) THEN
 394             NS = 0
 395             ND = 1
 396             IF( KWTOP.GT.KTOP )
 397      $         H( KWTOP, KWTOP-1 ) = ZERO
 398          END IF
 399          WORK( 1 ) = ONE
 400          RETURN
 401       END IF
 402 *
 403 *     ==== Convert to spike-triangular form.  (In case of a
 404 *     .    rare QR failure, this routine continues to do
 405 *     .    aggressive early deflation using that part of
 406 *     .    the deflation window that converged using INFQR
 407 *     .    here and there to keep track.) ====
 408 *
 409       CALL CLACPY( 'U', JW, JW, H( KWTOP, KWTOP ), LDH, T, LDT )
 410       CALL CCOPY( JW-1, H( KWTOP+1, KWTOP ), LDH+1, T( 2, 1 ), LDT+1 )
 411 *
 412       CALL CLASET( 'A', JW, JW, ZERO, ONE, V, LDV )
 413       NMIN = ILAENV( 12, 'CLAQR3', 'SV', JW, 1, JW, LWORK )
 414       IF( JW.GT.NMIN ) THEN
 415          CALL CLAQR4( .true., .true., JW, 1, JW, T, LDT, SH( KWTOP ), 1,
 416      $                JW, V, LDV, WORK, LWORK, INFQR )
 417       ELSE
 418          CALL CLAHQR( .true., .true., JW, 1, JW, T, LDT, SH( KWTOP ), 1,
 419      $                JW, V, LDV, INFQR )
 420       END IF
 421 *
 422 *     ==== Deflation detection loop ====
 423 *
 424       NS = JW
 425       ILST = INFQR + 1
 426       DO 10 KNT = INFQR + 1, JW
 427 *
 428 *        ==== Small spike tip deflation test ====
 429 *
 430          FOO = CABS1( T( NS, NS ) )
 431          IF( FOO.EQ.RZERO )
 432      $      FOO = CABS1( S )
 433          IF( CABS1( S )*CABS1( V( 1, NS ) ).LE.MAX( SMLNUM, ULP*FOO ) )
 434      $        THEN
 435 *
 436 *           ==== One more converged eigenvalue ====
 437 *
 438             NS = NS - 1
 439          ELSE
 440 *
 441 *           ==== One undeflatable eigenvalue.  Move it up out of the
 442 *           .    way.   (CTREXC can not fail in this case.) ====
 443 *
 444             IFST = NS
 445             CALL CTREXC( 'V', JW, T, LDT, V, LDV, IFST, ILST, INFO )
 446             ILST = ILST + 1
 447          END IF
 448    10 CONTINUE
 449 *
 450 *        ==== Return to Hessenberg form ====
 451 *
 452       IF( NS.EQ.0 )
 453      $   S = ZERO
 454 *
 455       IF( NS.LT.JW ) THEN
 456 *
 457 *        ==== sorting the diagonal of T improves accuracy for
 458 *        .    graded matrices.  ====
 459 *
 460          DO 30 I = INFQR + 1, NS
 461             IFST = I
 462             DO 20 J = I + 1, NS
 463                IF( CABS1( T( J, J ) ).GT.CABS1( T( IFST, IFST ) ) )
 464      $            IFST = J
 465    20       CONTINUE
 466             ILST = I
 467             IF( IFST.NE.ILST )
 468      $         CALL CTREXC( 'V', JW, T, LDT, V, LDV, IFST, ILST, INFO )
 469    30    CONTINUE
 470       END IF
 471 *
 472 *     ==== Restore shift/eigenvalue array from T ====
 473 *
 474       DO 40 I = INFQR + 1, JW
 475          SH( KWTOP+I-1 ) = T( I, I )
 476    40 CONTINUE
 477 *
 478 *
 479       IF( NS.LT.JW .OR. S.EQ.ZERO ) THEN
 480          IF( NS.GT.1 .AND. S.NE.ZERO ) THEN
 481 *
 482 *           ==== Reflect spike back into lower triangle ====
 483 *
 484             CALL CCOPY( NS, V, LDV, WORK, 1 )
 485             DO 50 I = 1, NS
 486                WORK( I ) = CONJG( WORK( I ) )
 487    50       CONTINUE
 488             BETA = WORK( 1 )
 489             CALL CLARFG( NS, BETA, WORK( 2 ), 1, TAU )
 490             WORK( 1 ) = ONE
 491 *
 492             CALL CLASET( 'L', JW-2, JW-2, ZERO, ZERO, T( 3, 1 ), LDT )
 493 *
 494             CALL CLARF( 'L', NS, JW, WORK, 1, CONJG( TAU ), T, LDT,
 495      $                  WORK( JW+1 ) )
 496             CALL CLARF( 'R', NS, NS, WORK, 1, TAU, T, LDT,
 497      $                  WORK( JW+1 ) )
 498             CALL CLARF( 'R', JW, NS, WORK, 1, TAU, V, LDV,
 499      $                  WORK( JW+1 ) )
 500 *
 501             CALL CGEHRD( JW, 1, NS, T, LDT, WORK, WORK( JW+1 ),
 502      $                   LWORK-JW, INFO )
 503          END IF
 504 *
 505 *        ==== Copy updated reduced window into place ====
 506 *
 507          IF( KWTOP.GT.1 )
 508      $      H( KWTOP, KWTOP-1 ) = S*CONJG( V( 1, 1 ) )
 509          CALL CLACPY( 'U', JW, JW, T, LDT, H( KWTOP, KWTOP ), LDH )
 510          CALL CCOPY( JW-1, T( 2, 1 ), LDT+1, H( KWTOP+1, KWTOP ),
 511      $               LDH+1 )
 512 *
 513 *        ==== Accumulate orthogonal matrix in order update
 514 *        .    H and Z, if requested.  ====
 515 *
 516          IF( NS.GT.1 .AND. S.NE.ZERO )
 517      $      CALL CUNMHR( 'R', 'N', JW, NS, 1, NS, T, LDT, WORK, V, LDV,
 518      $                   WORK( JW+1 ), LWORK-JW, INFO )
 519 *
 520 *        ==== Update vertical slab in H ====
 521 *
 522          IF( WANTT ) THEN
 523             LTOP = 1
 524          ELSE
 525             LTOP = KTOP
 526          END IF
 527          DO 60 KROW = LTOP, KWTOP - 1, NV
 528             KLN = MIN( NV, KWTOP-KROW )
 529             CALL CGEMM( 'N', 'N', KLN, JW, JW, ONE, H( KROW, KWTOP ),
 530      $                  LDH, V, LDV, ZERO, WV, LDWV )
 531             CALL CLACPY( 'A', KLN, JW, WV, LDWV, H( KROW, KWTOP ), LDH )
 532    60    CONTINUE
 533 *
 534 *        ==== Update horizontal slab in H ====
 535 *
 536          IF( WANTT ) THEN
 537             DO 70 KCOL = KBOT + 1, N, NH
 538                KLN = MIN( NH, N-KCOL+1 )
 539                CALL CGEMM( 'C', 'N', JW, KLN, JW, ONE, V, LDV,
 540      $                     H( KWTOP, KCOL ), LDH, ZERO, T, LDT )
 541                CALL CLACPY( 'A', JW, KLN, T, LDT, H( KWTOP, KCOL ),
 542      $                      LDH )
 543    70       CONTINUE
 544          END IF
 545 *
 546 *        ==== Update vertical slab in Z ====
 547 *
 548          IF( WANTZ ) THEN
 549             DO 80 KROW = ILOZ, IHIZ, NV
 550                KLN = MIN( NV, IHIZ-KROW+1 )
 551                CALL CGEMM( 'N', 'N', KLN, JW, JW, ONE, Z( KROW, KWTOP ),
 552      $                     LDZ, V, LDV, ZERO, WV, LDWV )
 553                CALL CLACPY( 'A', KLN, JW, WV, LDWV, Z( KROW, KWTOP ),
 554      $                      LDZ )
 555    80       CONTINUE
 556          END IF
 557       END IF
 558 *
 559 *     ==== Return the number of deflations ... ====
 560 *
 561       ND = JW - NS
 562 *
 563 *     ==== ... and the number of shifts. (Subtracting
 564 *     .    INFQR from the spike length takes care
 565 *     .    of the case of a rare QR failure while
 566 *     .    calculating eigenvalues of the deflation
 567 *     .    window.)  ====
 568 *
 569       NS = NS - INFQR
 570 *
 571 *      ==== Return optimal workspace. ====
 572 *
 573       WORK( 1 ) = CMPLX( LWKOPT, 0 )
 574 *
 575 *     ==== End of CLAQR3 ====
 576 *
 577       END