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

◆ slaqr1()

subroutine slaqr1 ( integer n,
real, dimension( ldh, * ) h,
integer ldh,
real sr1,
real si1,
real sr2,
real si2,
real, dimension( * ) v )

SLAQR1 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 SLAQR1 + dependencies [TGZ] [ZIP] [TXT]

Purpose:
!>
!>      Given a 2-by-2 or 3-by-3 matrix H, SLAQR1 sets v to a
!>      scalar multiple of the first column of the product
!>
!>      (*)  K = (H - (sr1 + i*si1)*I)*(H - (sr2 + i*si2)*I)
!>
!>      scaling to avoid overflows and most underflows. It
!>      is assumed that either
!>
!>              1) sr1 = sr2 and si1 = -si2
!>          or
!>              2) si1 = si2 = 0.
!>
!>      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 REAL 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]SR1
!>          SR1 is REAL
!> 
[in]SI1
!>          SI1 is REAL
!> 
[in]SR2
!>          SR2 is REAL
!> 
[in]SI2
!>          SI2 is REAL
!>              The shifts in (*).
!> 
[out]V
!>          V is REAL 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 118 of file slaqr1.f.

119*
120* -- LAPACK auxiliary routine --
121* -- LAPACK is a software package provided by Univ. of Tennessee, --
122* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
123*
124* .. Scalar Arguments ..
125 REAL SI1, SI2, SR1, SR2
126 INTEGER LDH, N
127* ..
128* .. Array Arguments ..
129 REAL H( LDH, * ), V( * )
130* ..
131*
132* ================================================================
133*
134* .. Parameters ..
135 REAL ZERO
136 parameter( zero = 0.0e0 )
137* ..
138* .. Local Scalars ..
139 REAL H21S, H31S, S
140* ..
141* .. Intrinsic Functions ..
142 INTRINSIC abs
143* ..
144* .. Executable Statements ..
145*
146* Quick return if possible
147*
148 IF( n.NE.2 .AND. n.NE.3 ) THEN
149 RETURN
150 END IF
151*
152 IF( n.EQ.2 ) THEN
153 s = abs( h( 1, 1 )-sr2 ) + abs( si2 ) + abs( h( 2, 1 ) )
154 IF( s.EQ.zero ) THEN
155 v( 1 ) = zero
156 v( 2 ) = zero
157 ELSE
158 h21s = h( 2, 1 ) / s
159 v( 1 ) = h21s*h( 1, 2 ) + ( h( 1, 1 )-sr1 )*
160 $ ( ( h( 1, 1 )-sr2 ) / s ) - si1*( si2 / s )
161 v( 2 ) = h21s*( h( 1, 1 )+h( 2, 2 )-sr1-sr2 )
162 END IF
163 ELSE
164 s = abs( h( 1, 1 )-sr2 ) + abs( si2 ) + abs( h( 2, 1 ) ) +
165 $ abs( h( 3, 1 ) )
166 IF( s.EQ.zero ) THEN
167 v( 1 ) = zero
168 v( 2 ) = zero
169 v( 3 ) = zero
170 ELSE
171 h21s = h( 2, 1 ) / s
172 h31s = h( 3, 1 ) / s
173 v( 1 ) = ( h( 1, 1 )-sr1 )*( ( h( 1, 1 )-sr2 ) / s ) -
174 $ si1*( si2 / s ) + h( 1, 2 )*h21s + h( 1, 3 )*h31s
175 v( 2 ) = h21s*( h( 1, 1 )+h( 2, 2 )-sr1-sr2 ) +
176 $ h( 2, 3 )*h31s
177 v( 3 ) = h31s*( h( 1, 1 )+h( 3, 3 )-sr1-sr2 ) +
178 $ h21s*h( 3, 2 )
179 END IF
180 END IF
Here is the caller graph for this function: