![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
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