LAPACK 3.12.1
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ claqr1()

subroutine claqr1 ( integer n,
complex, dimension( ldh, * ) h,
integer ldh,
complex s1,
complex s2,
complex, dimension( * ) v )

CLAQR1 sets a scalar multiple of the first column of the product of 2-by-2 or 3-by-3 matrix H and specified shifts.

Download CLAQR1 + dependencies [TGZ] [ZIP] [TXT]

Purpose:
!>
!>      Given a 2-by-2 or 3-by-3 matrix H, CLAQR1 sets v to a
!>      scalar multiple of the first column of the product
!>
!>      (*)  K = (H - s1*I)*(H - s2*I)
!>
!>      scaling to avoid overflows and most underflows.
!>
!>      This is useful for starting double implicit shift bulges
!>      in the QR algorithm.
!> 
Parameters
[in]N
!>          N is INTEGER
!>              Order of the matrix H. N must be either 2 or 3.
!> 
[in]H
!>          H is COMPLEX array, dimension (LDH,N)
!>              The 2-by-2 or 3-by-3 matrix H in (*).
!> 
[in]LDH
!>          LDH is INTEGER
!>              The leading dimension of H as declared in
!>              the calling procedure.  LDH >= N
!> 
[in]S1
!>          S1 is COMPLEX
!> 
[in]S2
!>          S2 is COMPLEX
!>
!>          S1 and S2 are the shifts defining K in (*) above.
!> 
[out]V
!>          V is COMPLEX array, dimension (N)
!>              A scalar multiple of the first column of the
!>              matrix K in (*).
!> 
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Contributors:
Karen Braman and Ralph Byers, Department of Mathematics, University of Kansas, USA

Definition at line 104 of file claqr1.f.

105*
106* -- LAPACK auxiliary routine --
107* -- LAPACK is a software package provided by Univ. of Tennessee, --
108* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
109*
110* .. Scalar Arguments ..
111 COMPLEX S1, S2
112 INTEGER LDH, N
113* ..
114* .. Array Arguments ..
115 COMPLEX H( LDH, * ), V( * )
116* ..
117*
118* ================================================================
119*
120* .. Parameters ..
121 COMPLEX ZERO
122 parameter( zero = ( 0.0e0, 0.0e0 ) )
123 REAL RZERO
124 parameter( rzero = 0.0e0 )
125* ..
126* .. Local Scalars ..
127 COMPLEX CDUM, H21S, H31S
128 REAL S
129* ..
130* .. Intrinsic Functions ..
131 INTRINSIC abs, aimag, real
132* ..
133* .. Statement Functions ..
134 REAL CABS1
135* ..
136* .. Statement Function definitions ..
137 cabs1( cdum ) = abs( real( cdum ) ) + abs( aimag( cdum ) )
138* ..
139* .. Executable Statements ..
140*
141* Quick return if possible
142*
143 IF( n.NE.2 .AND. n.NE.3 ) THEN
144 RETURN
145 END IF
146*
147 IF( n.EQ.2 ) THEN
148 s = cabs1( h( 1, 1 )-s2 ) + cabs1( h( 2, 1 ) )
149 IF( s.EQ.rzero ) THEN
150 v( 1 ) = zero
151 v( 2 ) = zero
152 ELSE
153 h21s = h( 2, 1 ) / s
154 v( 1 ) = h21s*h( 1, 2 ) + ( h( 1, 1 )-s1 )*
155 $ ( ( h( 1, 1 )-s2 ) / s )
156 v( 2 ) = h21s*( h( 1, 1 )+h( 2, 2 )-s1-s2 )
157 END IF
158 ELSE
159 s = cabs1( h( 1, 1 )-s2 ) + cabs1( h( 2, 1 ) ) +
160 $ cabs1( h( 3, 1 ) )
161 IF( s.EQ.zero ) THEN
162 v( 1 ) = zero
163 v( 2 ) = zero
164 v( 3 ) = zero
165 ELSE
166 h21s = h( 2, 1 ) / s
167 h31s = h( 3, 1 ) / s
168 v( 1 ) = ( h( 1, 1 )-s1 )*( ( h( 1, 1 )-s2 ) / s ) +
169 $ h( 1, 2 )*h21s + h( 1, 3 )*h31s
170 v( 2 ) = h21s*( h( 1, 1 )+h( 2, 2 )-s1-s2 ) + h( 2, 3 )*h31s
171 v( 3 ) = h31s*( h( 1, 1 )+h( 3, 3 )-s1-s2 ) + h21s*h( 3, 2 )
172 END IF
173 END IF
Here is the caller graph for this function: