LAPACK 3.12.1
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
slaqr2.f
Go to the documentation of this file.
1*> \brief \b SLAQR2 performs the orthogonal 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*> Download SLAQR2 + dependencies
9*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slaqr2.f">
10*> [TGZ]</a>
11*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slaqr2.f">
12*> [ZIP]</a>
13*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slaqr2.f">
14*> [TXT]</a>
15*
16* Definition:
17* ===========
18*
19* SUBROUTINE SLAQR2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH, ILOZ,
20* IHIZ, Z, LDZ, NS, ND, SR, SI, V, LDV, NH, T,
21* LDT, NV, WV, LDWV, WORK, LWORK )
22*
23* .. Scalar Arguments ..
24* INTEGER IHIZ, ILOZ, KBOT, KTOP, LDH, LDT, LDV, LDWV,
25* $ LDZ, LWORK, N, ND, NH, NS, NV, NW
26* LOGICAL WANTT, WANTZ
27* ..
28* .. Array Arguments ..
29* REAL H( LDH, * ), SI( * ), SR( * ), T( LDT, * ),
30* $ V( LDV, * ), WORK( * ), WV( LDWV, * ),
31* $ Z( LDZ, * )
32* ..
33*
34*
35*> \par Purpose:
36* =============
37*>
38*> \verbatim
39*>
40*> SLAQR2 is identical to SLAQR3 except that it avoids
41*> recursion by calling SLAHQR instead of SLAQR4.
42*>
43*> Aggressive early deflation:
44*>
45*> This subroutine accepts as input an upper Hessenberg matrix
46*> H and performs an orthogonal similarity transformation
47*> designed to detect and deflate fully converged eigenvalues from
48*> a trailing principal submatrix. On output H has been over-
49*> written by a new Hessenberg matrix that is a perturbation of
50*> an orthogonal similarity transformation of H. It is to be
51*> hoped that the final version of H has many zero subdiagonal
52*> entries.
53*> \endverbatim
54*
55* Arguments:
56* ==========
57*
58*> \param[in] WANTT
59*> \verbatim
60*> WANTT is LOGICAL
61*> If .TRUE., then the Hessenberg matrix H is fully updated
62*> so that the quasi-triangular Schur factor may be
63*> computed (in cooperation with the calling subroutine).
64*> If .FALSE., then only enough of H is updated to preserve
65*> the eigenvalues.
66*> \endverbatim
67*>
68*> \param[in] WANTZ
69*> \verbatim
70*> WANTZ is LOGICAL
71*> If .TRUE., then the orthogonal matrix Z is updated so
72*> so that the orthogonal Schur factor may be computed
73*> (in cooperation with the calling subroutine).
74*> If .FALSE., then Z is not referenced.
75*> \endverbatim
76*>
77*> \param[in] N
78*> \verbatim
79*> N is INTEGER
80*> The order of the matrix H and (if WANTZ is .TRUE.) the
81*> order of the orthogonal matrix Z.
82*> \endverbatim
83*>
84*> \param[in] KTOP
85*> \verbatim
86*> KTOP is INTEGER
87*> It is assumed that either KTOP = 1 or H(KTOP,KTOP-1)=0.
88*> KBOT and KTOP together determine an isolated block
89*> along the diagonal of the Hessenberg matrix.
90*> \endverbatim
91*>
92*> \param[in] KBOT
93*> \verbatim
94*> KBOT is INTEGER
95*> It is assumed without a check that either
96*> KBOT = N or H(KBOT+1,KBOT)=0. KBOT and KTOP together
97*> determine an isolated block along the diagonal of the
98*> Hessenberg matrix.
99*> \endverbatim
100*>
101*> \param[in] NW
102*> \verbatim
103*> NW is INTEGER
104*> Deflation window size. 1 <= NW <= (KBOT-KTOP+1).
105*> \endverbatim
106*>
107*> \param[in,out] H
108*> \verbatim
109*> H is REAL array, dimension (LDH,N)
110*> On input the initial N-by-N section of H stores the
111*> Hessenberg matrix undergoing aggressive early deflation.
112*> On output H has been transformed by an orthogonal
113*> similarity transformation, perturbed, and the returned
114*> to Hessenberg form that (it is to be hoped) has some
115*> zero subdiagonal entries.
116*> \endverbatim
117*>
118*> \param[in] LDH
119*> \verbatim
120*> LDH is INTEGER
121*> Leading dimension of H just as declared in the calling
122*> subroutine. N <= LDH
123*> \endverbatim
124*>
125*> \param[in] ILOZ
126*> \verbatim
127*> ILOZ is INTEGER
128*> \endverbatim
129*>
130*> \param[in] IHIZ
131*> \verbatim
132*> IHIZ is INTEGER
133*> Specify the rows of Z to which transformations must be
134*> applied if WANTZ is .TRUE.. 1 <= ILOZ <= IHIZ <= N.
135*> \endverbatim
136*>
137*> \param[in,out] Z
138*> \verbatim
139*> Z is REAL array, dimension (LDZ,N)
140*> IF WANTZ is .TRUE., then on output, the orthogonal
141*> similarity transformation mentioned above has been
142*> accumulated into Z(ILOZ:IHIZ,ILOZ:IHIZ) from the right.
143*> If WANTZ is .FALSE., then Z is unreferenced.
144*> \endverbatim
145*>
146*> \param[in] LDZ
147*> \verbatim
148*> LDZ is INTEGER
149*> The leading dimension of Z just as declared in the
150*> calling subroutine. 1 <= LDZ.
151*> \endverbatim
152*>
153*> \param[out] NS
154*> \verbatim
155*> NS is INTEGER
156*> The number of unconverged (ie approximate) eigenvalues
157*> returned in SR and SI that may be used as shifts by the
158*> calling subroutine.
159*> \endverbatim
160*>
161*> \param[out] ND
162*> \verbatim
163*> ND is INTEGER
164*> The number of converged eigenvalues uncovered by this
165*> subroutine.
166*> \endverbatim
167*>
168*> \param[out] SR
169*> \verbatim
170*> SR is REAL array, dimension (KBOT)
171*> \endverbatim
172*>
173*> \param[out] SI
174*> \verbatim
175*> SI is REAL array, dimension (KBOT)
176*> On output, the real and imaginary parts of approximate
177*> eigenvalues that may be used for shifts are stored in
178*> SR(KBOT-ND-NS+1) through SR(KBOT-ND) and
179*> SI(KBOT-ND-NS+1) through SI(KBOT-ND), respectively.
180*> The real and imaginary parts of converged eigenvalues
181*> are stored in SR(KBOT-ND+1) through SR(KBOT) and
182*> SI(KBOT-ND+1) through SI(KBOT), respectively.
183*> \endverbatim
184*>
185*> \param[out] V
186*> \verbatim
187*> V is REAL array, dimension (LDV,NW)
188*> An NW-by-NW work array.
189*> \endverbatim
190*>
191*> \param[in] LDV
192*> \verbatim
193*> LDV is INTEGER
194*> The leading dimension of V just as declared in the
195*> calling subroutine. NW <= LDV
196*> \endverbatim
197*>
198*> \param[in] NH
199*> \verbatim
200*> NH is INTEGER
201*> The number of columns of T. NH >= NW.
202*> \endverbatim
203*>
204*> \param[out] T
205*> \verbatim
206*> T is REAL array, dimension (LDT,NW)
207*> \endverbatim
208*>
209*> \param[in] LDT
210*> \verbatim
211*> LDT is INTEGER
212*> The leading dimension of T just as declared in the
213*> calling subroutine. NW <= LDT
214*> \endverbatim
215*>
216*> \param[in] NV
217*> \verbatim
218*> NV is INTEGER
219*> The number of rows of work array WV available for
220*> workspace. NV >= NW.
221*> \endverbatim
222*>
223*> \param[out] WV
224*> \verbatim
225*> WV is REAL array, dimension (LDWV,NW)
226*> \endverbatim
227*>
228*> \param[in] LDWV
229*> \verbatim
230*> LDWV is INTEGER
231*> The leading dimension of W just as declared in the
232*> calling subroutine. NW <= LDV
233*> \endverbatim
234*>
235*> \param[out] WORK
236*> \verbatim
237*> WORK is REAL array, dimension (LWORK)
238*> On exit, WORK(1) is set to an estimate of the optimal value
239*> of LWORK for the given values of N, NW, KTOP and KBOT.
240*> \endverbatim
241*>
242*> \param[in] LWORK
243*> \verbatim
244*> LWORK is INTEGER
245*> The dimension of the work array WORK. LWORK = 2*NW
246*> suffices, but greater efficiency may result from larger
247*> values of LWORK.
248*>
249*> If LWORK = -1, then a workspace query is assumed; SLAQR2
250*> only estimates the optimal workspace size for the given
251*> values of N, NW, KTOP and KBOT. The estimate is returned
252*> in WORK(1). No error message related to LWORK is issued
253*> by XERBLA. Neither H nor Z are accessed.
254*> \endverbatim
255*
256* Authors:
257* ========
258*
259*> \author Univ. of Tennessee
260*> \author Univ. of California Berkeley
261*> \author Univ. of Colorado Denver
262*> \author NAG Ltd.
263*
264*> \ingroup laqr2
265*
266*> \par Contributors:
267* ==================
268*>
269*> Karen Braman and Ralph Byers, Department of Mathematics,
270*> University of Kansas, USA
271*>
272* =====================================================================
273 SUBROUTINE slaqr2( WANTT, WANTZ, N, KTOP, KBOT, NW, H, LDH,
274 $ ILOZ,
275 $ IHIZ, Z, LDZ, NS, ND, SR, SI, V, LDV, NH, T,
276 $ LDT, NV, WV, LDWV, WORK, LWORK )
277*
278* -- LAPACK auxiliary routine --
279* -- LAPACK is a software package provided by Univ. of Tennessee, --
280* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
281*
282* .. Scalar Arguments ..
283 INTEGER IHIZ, ILOZ, KBOT, KTOP, LDH, LDT, LDV, LDWV,
284 $ LDZ, LWORK, N, ND, NH, NS, NV, NW
285 LOGICAL WANTT, WANTZ
286* ..
287* .. Array Arguments ..
288 REAL H( LDH, * ), SI( * ), SR( * ), T( LDT, * ),
289 $ V( LDV, * ), WORK( * ), WV( LDWV, * ),
290 $ Z( LDZ, * )
291* ..
292*
293* ================================================================
294* .. Parameters ..
295 REAL ZERO, ONE
296 PARAMETER ( ZERO = 0.0e0, one = 1.0e0 )
297* ..
298* .. Local Scalars ..
299 REAL AA, BB, CC, CS, DD, EVI, EVK, FOO, S,
300 $ SAFMAX, SAFMIN, SMLNUM, SN, TAU, ULP
301 INTEGER I, IFST, ILST, INFO, INFQR, J, JW, K, KCOL,
302 $ kend, kln, krow, kwtop, ltop, lwk1, lwk2,
303 $ lwkopt
304 LOGICAL BULGE, SORTED
305* ..
306* .. External Functions ..
307 REAL SLAMCH, SROUNDUP_LWORK
308 EXTERNAL SLAMCH, SROUNDUP_LWORK
309* ..
310* .. External Subroutines ..
311 EXTERNAL scopy, sgehrd, sgemm, slacpy,
312 $ slahqr,
314 $ strexc
315* ..
316* .. Intrinsic Functions ..
317 INTRINSIC abs, int, max, min, real, sqrt
318* ..
319* .. Executable Statements ..
320*
321* ==== Estimate optimal workspace. ====
322*
323 jw = min( nw, kbot-ktop+1 )
324 IF( jw.LE.2 ) THEN
325 lwkopt = 1
326 ELSE
327*
328* ==== Workspace query call to SGEHRD ====
329*
330 CALL sgehrd( jw, 1, jw-1, t, ldt, work, work, -1, info )
331 lwk1 = int( work( 1 ) )
332*
333* ==== Workspace query call to SORMHR ====
334*
335 CALL sormhr( 'R', 'N', jw, jw, 1, jw-1, t, ldt, work, v,
336 $ ldv,
337 $ work, -1, info )
338 lwk2 = int( work( 1 ) )
339*
340* ==== Optimal workspace ====
341*
342 lwkopt = jw + max( lwk1, lwk2 )
343 END IF
344*
345* ==== Quick return in case of workspace query. ====
346*
347 IF( lwork.EQ.-1 ) THEN
348 work( 1 ) = sroundup_lwork( lwkopt )
349 RETURN
350 END IF
351*
352* ==== Nothing to do ...
353* ... for an empty active block ... ====
354 ns = 0
355 nd = 0
356 work( 1 ) = one
357 IF( ktop.GT.kbot )
358 $ RETURN
359* ... nor for an empty deflation window. ====
360 IF( nw.LT.1 )
361 $ RETURN
362*
363* ==== Machine constants ====
364*
365 safmin = slamch( 'SAFE MINIMUM' )
366 safmax = one / safmin
367 ulp = slamch( 'PRECISION' )
368 smlnum = safmin*( real( n ) / ulp )
369*
370* ==== Setup deflation window ====
371*
372 jw = min( nw, kbot-ktop+1 )
373 kwtop = kbot - jw + 1
374 IF( kwtop.EQ.ktop ) THEN
375 s = zero
376 ELSE
377 s = h( kwtop, kwtop-1 )
378 END IF
379*
380 IF( kbot.EQ.kwtop ) THEN
381*
382* ==== 1-by-1 deflation window: not much to do ====
383*
384 sr( kwtop ) = h( kwtop, kwtop )
385 si( kwtop ) = zero
386 ns = 1
387 nd = 0
388 IF( abs( s ).LE.max( smlnum, ulp*abs( h( kwtop, kwtop ) ) ) )
389 $ THEN
390 ns = 0
391 nd = 1
392 IF( kwtop.GT.ktop )
393 $ h( kwtop, kwtop-1 ) = zero
394 END IF
395 work( 1 ) = one
396 RETURN
397 END IF
398*
399* ==== Convert to spike-triangular form. (In case of a
400* . rare QR failure, this routine continues to do
401* . aggressive early deflation using that part of
402* . the deflation window that converged using INFQR
403* . here and there to keep track.) ====
404*
405 CALL slacpy( 'U', jw, jw, h( kwtop, kwtop ), ldh, t, ldt )
406 CALL scopy( jw-1, h( kwtop+1, kwtop ), ldh+1, t( 2, 1 ),
407 $ ldt+1 )
408*
409 CALL slaset( 'A', jw, jw, zero, one, v, ldv )
410 CALL slahqr( .true., .true., jw, 1, jw, t, ldt, sr( kwtop ),
411 $ si( kwtop ), 1, jw, v, ldv, infqr )
412*
413* ==== STREXC needs a clean margin near the diagonal ====
414*
415 DO 10 j = 1, jw - 3
416 t( j+2, j ) = zero
417 t( j+3, j ) = zero
418 10 CONTINUE
419 IF( jw.GT.2 )
420 $ t( jw, jw-2 ) = zero
421*
422* ==== Deflation detection loop ====
423*
424 ns = jw
425 ilst = infqr + 1
426 20 CONTINUE
427 IF( ilst.LE.ns ) THEN
428 IF( ns.EQ.1 ) THEN
429 bulge = .false.
430 ELSE
431 bulge = t( ns, ns-1 ).NE.zero
432 END IF
433*
434* ==== Small spike tip test for deflation ====
435*
436 IF( .NOT.bulge ) THEN
437*
438* ==== Real eigenvalue ====
439*
440 foo = abs( t( ns, ns ) )
441 IF( foo.EQ.zero )
442 $ foo = abs( s )
443 IF( abs( s*v( 1, ns ) ).LE.max( smlnum, ulp*foo ) ) THEN
444*
445* ==== Deflatable ====
446*
447 ns = ns - 1
448 ELSE
449*
450* ==== Undeflatable. Move it up out of the way.
451* . (STREXC can not fail in this case.) ====
452*
453 ifst = ns
454 CALL strexc( 'V', jw, t, ldt, v, ldv, ifst, ilst,
455 $ work,
456 $ info )
457 ilst = ilst + 1
458 END IF
459 ELSE
460*
461* ==== Complex conjugate pair ====
462*
463 foo = abs( t( ns, ns ) ) + sqrt( abs( t( ns, ns-1 ) ) )*
464 $ sqrt( abs( t( ns-1, ns ) ) )
465 IF( foo.EQ.zero )
466 $ foo = abs( s )
467 IF( max( abs( s*v( 1, ns ) ), abs( s*v( 1, ns-1 ) ) ).LE.
468 $ max( smlnum, ulp*foo ) ) THEN
469*
470* ==== Deflatable ====
471*
472 ns = ns - 2
473 ELSE
474*
475* ==== Undeflatable. Move them up out of the way.
476* . Fortunately, STREXC does the right thing with
477* . ILST in case of a rare exchange failure. ====
478*
479 ifst = ns
480 CALL strexc( 'V', jw, t, ldt, v, ldv, ifst, ilst,
481 $ work,
482 $ info )
483 ilst = ilst + 2
484 END IF
485 END IF
486*
487* ==== End deflation detection loop ====
488*
489 GO TO 20
490 END IF
491*
492* ==== Return to Hessenberg form ====
493*
494 IF( ns.EQ.0 )
495 $ s = zero
496*
497 IF( ns.LT.jw ) THEN
498*
499* ==== sorting diagonal blocks of T improves accuracy for
500* . graded matrices. Bubble sort deals well with
501* . exchange failures. ====
502*
503 sorted = .false.
504 i = ns + 1
505 30 CONTINUE
506 IF( sorted )
507 $ GO TO 50
508 sorted = .true.
509*
510 kend = i - 1
511 i = infqr + 1
512 IF( i.EQ.ns ) THEN
513 k = i + 1
514 ELSE IF( t( i+1, i ).EQ.zero ) THEN
515 k = i + 1
516 ELSE
517 k = i + 2
518 END IF
519 40 CONTINUE
520 IF( k.LE.kend ) THEN
521 IF( k.EQ.i+1 ) THEN
522 evi = abs( t( i, i ) )
523 ELSE
524 evi = abs( t( i, i ) ) + sqrt( abs( t( i+1, i ) ) )*
525 $ sqrt( abs( t( i, i+1 ) ) )
526 END IF
527*
528 IF( k.EQ.kend ) THEN
529 evk = abs( t( k, k ) )
530 ELSE IF( t( k+1, k ).EQ.zero ) THEN
531 evk = abs( t( k, k ) )
532 ELSE
533 evk = abs( t( k, k ) ) + sqrt( abs( t( k+1, k ) ) )*
534 $ sqrt( abs( t( k, k+1 ) ) )
535 END IF
536*
537 IF( evi.GE.evk ) THEN
538 i = k
539 ELSE
540 sorted = .false.
541 ifst = i
542 ilst = k
543 CALL strexc( 'V', jw, t, ldt, v, ldv, ifst, ilst,
544 $ work,
545 $ info )
546 IF( info.EQ.0 ) THEN
547 i = ilst
548 ELSE
549 i = k
550 END IF
551 END IF
552 IF( i.EQ.kend ) THEN
553 k = i + 1
554 ELSE IF( t( i+1, i ).EQ.zero ) THEN
555 k = i + 1
556 ELSE
557 k = i + 2
558 END IF
559 GO TO 40
560 END IF
561 GO TO 30
562 50 CONTINUE
563 END IF
564*
565* ==== Restore shift/eigenvalue array from T ====
566*
567 i = jw
568 60 CONTINUE
569 IF( i.GE.infqr+1 ) THEN
570 IF( i.EQ.infqr+1 ) THEN
571 sr( kwtop+i-1 ) = t( i, i )
572 si( kwtop+i-1 ) = zero
573 i = i - 1
574 ELSE IF( t( i, i-1 ).EQ.zero ) THEN
575 sr( kwtop+i-1 ) = t( i, i )
576 si( kwtop+i-1 ) = zero
577 i = i - 1
578 ELSE
579 aa = t( i-1, i-1 )
580 cc = t( i, i-1 )
581 bb = t( i-1, i )
582 dd = t( i, i )
583 CALL slanv2( aa, bb, cc, dd, sr( kwtop+i-2 ),
584 $ si( kwtop+i-2 ), sr( kwtop+i-1 ),
585 $ si( kwtop+i-1 ), cs, sn )
586 i = i - 2
587 END IF
588 GO TO 60
589 END IF
590*
591 IF( ns.LT.jw .OR. s.EQ.zero ) THEN
592 IF( ns.GT.1 .AND. s.NE.zero ) THEN
593*
594* ==== Reflect spike back into lower triangle ====
595*
596 CALL scopy( ns, v, ldv, work, 1 )
597 CALL slarfg( ns, work( 1 ), work( 2 ), 1, tau )
598*
599 CALL slaset( 'L', jw-2, jw-2, zero, zero, t( 3, 1 ),
600 $ ldt )
601*
602 CALL slarf1f( 'L', ns, jw, work, 1, tau, t, ldt,
603 $ work( jw+1 ) )
604 CALL slarf1f( 'R', ns, ns, work, 1, tau, t, ldt,
605 $ work( jw+1 ) )
606 CALL slarf1f( 'R', jw, ns, work, 1, tau, v, ldv,
607 $ work( jw+1 ) )
608*
609 CALL sgehrd( jw, 1, ns, t, ldt, work, work( jw+1 ),
610 $ lwork-jw, info )
611 END IF
612*
613* ==== Copy updated reduced window into place ====
614*
615 IF( kwtop.GT.1 )
616 $ h( kwtop, kwtop-1 ) = s*v( 1, 1 )
617 CALL slacpy( 'U', jw, jw, t, ldt, h( kwtop, kwtop ), ldh )
618 CALL scopy( jw-1, t( 2, 1 ), ldt+1, h( kwtop+1, kwtop ),
619 $ ldh+1 )
620*
621* ==== Accumulate orthogonal matrix in order update
622* . H and Z, if requested. ====
623*
624 IF( ns.GT.1 .AND. s.NE.zero )
625 $ CALL sormhr( 'R', 'N', jw, ns, 1, ns, t, ldt, work, v,
626 $ ldv,
627 $ work( jw+1 ), lwork-jw, info )
628*
629* ==== Update vertical slab in H ====
630*
631 IF( wantt ) THEN
632 ltop = 1
633 ELSE
634 ltop = ktop
635 END IF
636 DO 70 krow = ltop, kwtop - 1, nv
637 kln = min( nv, kwtop-krow )
638 CALL sgemm( 'N', 'N', kln, jw, jw, one, h( krow, kwtop ),
639 $ ldh, v, ldv, zero, wv, ldwv )
640 CALL slacpy( 'A', kln, jw, wv, ldwv, h( krow, kwtop ),
641 $ ldh )
642 70 CONTINUE
643*
644* ==== Update horizontal slab in H ====
645*
646 IF( wantt ) THEN
647 DO 80 kcol = kbot + 1, n, nh
648 kln = min( nh, n-kcol+1 )
649 CALL sgemm( 'C', 'N', jw, kln, jw, one, v, ldv,
650 $ h( kwtop, kcol ), ldh, zero, t, ldt )
651 CALL slacpy( 'A', jw, kln, t, ldt, h( kwtop, kcol ),
652 $ ldh )
653 80 CONTINUE
654 END IF
655*
656* ==== Update vertical slab in Z ====
657*
658 IF( wantz ) THEN
659 DO 90 krow = iloz, ihiz, nv
660 kln = min( nv, ihiz-krow+1 )
661 CALL sgemm( 'N', 'N', kln, jw, jw, one, z( krow,
662 $ kwtop ),
663 $ ldz, v, ldv, zero, wv, ldwv )
664 CALL slacpy( 'A', kln, jw, wv, ldwv, z( krow, kwtop ),
665 $ ldz )
666 90 CONTINUE
667 END IF
668 END IF
669*
670* ==== Return the number of deflations ... ====
671*
672 nd = jw - ns
673*
674* ==== ... and the number of shifts. (Subtracting
675* . INFQR from the spike length takes care
676* . of the case of a rare QR failure while
677* . calculating eigenvalues of the deflation
678* . window.) ====
679*
680 ns = ns - infqr
681*
682* ==== Return optimal workspace. ====
683*
684 work( 1 ) = sroundup_lwork( lwkopt )
685*
686* ==== End of SLAQR2 ====
687*
688 END
subroutine scopy(n, sx, incx, sy, incy)
SCOPY
Definition scopy.f:82
subroutine sgehrd(n, ilo, ihi, a, lda, tau, work, lwork, info)
SGEHRD
Definition sgehrd.f:166
subroutine sgemm(transa, transb, m, n, k, alpha, a, lda, b, ldb, beta, c, ldc)
SGEMM
Definition sgemm.f:188
subroutine slacpy(uplo, m, n, a, lda, b, ldb)
SLACPY copies all or part of one two-dimensional array to another.
Definition slacpy.f:101
subroutine slahqr(wantt, wantz, n, ilo, ihi, h, ldh, wr, wi, iloz, ihiz, z, ldz, info)
SLAHQR computes the eigenvalues and Schur factorization of an upper Hessenberg matrix,...
Definition slahqr.f:205
subroutine slanv2(a, b, c, d, rt1r, rt1i, rt2r, rt2i, cs, sn)
SLANV2 computes the Schur factorization of a real 2-by-2 nonsymmetric matrix in standard form.
Definition slanv2.f:125
subroutine slaqr2(wantt, wantz, n, ktop, kbot, nw, h, ldh, iloz, ihiz, z, ldz, ns, nd, sr, si, v, ldv, nh, t, ldt, nv, wv, ldwv, work, lwork)
SLAQR2 performs the orthogonal similarity transformation of a Hessenberg matrix to detect and deflate...
Definition slaqr2.f:277
subroutine slarfg(n, alpha, x, incx, tau)
SLARFG generates an elementary reflector (Householder matrix).
Definition slarfg.f:104
subroutine slaset(uplo, m, n, alpha, beta, a, lda)
SLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values.
Definition slaset.f:108
subroutine strexc(compq, n, t, ldt, q, ldq, ifst, ilst, work, info)
STREXC
Definition strexc.f:146
subroutine sormhr(side, trans, m, n, ilo, ihi, a, lda, tau, c, ldc, work, lwork, info)
SORMHR
Definition sormhr.f:177
subroutine slarf1f(side, m, n, v, incv, tau, c, ldc, work)
SLARF1F applies an elementary reflector to a general rectangular
Definition slarf1f.f:123
subroutine slarf1l(side, m, n, v, incv, tau, c, ldc, work)
SLARF1L applies an elementary reflector to a general rectangular
Definition slarf1l.f:125