1 SUBROUTINE DLAQR1( N, H, LDH, SR1, SI1, SR2, SI2, V )
2 *
3 * -- LAPACK auxiliary routine (version 3.2) --
4 * Univ. of Tennessee, Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..
5 * November 2006
6 *
7 * .. Scalar Arguments ..
8 DOUBLE PRECISION SI1, SI2, SR1, SR2
9 INTEGER LDH, N
10 * ..
11 * .. Array Arguments ..
12 DOUBLE PRECISION H( LDH, * ), V( * )
13 * ..
14 *
15 * Given a 2-by-2 or 3-by-3 matrix H, DLAQR1 sets v to a
16 * scalar multiple of the first column of the product
17 *
18 * (*) K = (H - (sr1 + i*si1)*I)*(H - (sr2 + i*si2)*I)
19 *
20 * scaling to avoid overflows and most underflows. It
21 * is assumed that either
22 *
23 * 1) sr1 = sr2 and si1 = -si2
24 * or
25 * 2) si1 = si2 = 0.
26 *
27 * This is useful for starting double implicit shift bulges
28 * in the QR algorithm.
29 *
30 *
31 * N (input) integer
32 * Order of the matrix H. N must be either 2 or 3.
33 *
34 * H (input) DOUBLE PRECISION array of dimension (LDH,N)
35 * The 2-by-2 or 3-by-3 matrix H in (*).
36 *
37 * LDH (input) integer
38 * The leading dimension of H as declared in
39 * the calling procedure. LDH.GE.N
40 *
41 * SR1 (input) DOUBLE PRECISION
42 * SI1 The shifts in (*).
43 * SR2
44 * SI2
45 *
46 * V (output) DOUBLE PRECISION array of dimension N
47 * A scalar multiple of the first column of the
48 * matrix K in (*).
49 *
50 * ================================================================
51 * Based on contributions by
52 * Karen Braman and Ralph Byers, Department of Mathematics,
53 * University of Kansas, USA
54 *
55 * ================================================================
56 *
57 * .. Parameters ..
58 DOUBLE PRECISION ZERO
59 PARAMETER ( ZERO = 0.0d0 )
60 * ..
61 * .. Local Scalars ..
62 DOUBLE PRECISION H21S, H31S, S
63 * ..
64 * .. Intrinsic Functions ..
65 INTRINSIC ABS
66 * ..
67 * .. Executable Statements ..
68 IF( N.EQ.2 ) THEN
69 S = ABS( H( 1, 1 )-SR2 ) + ABS( SI2 ) + ABS( H( 2, 1 ) )
70 IF( S.EQ.ZERO ) THEN
71 V( 1 ) = ZERO
72 V( 2 ) = ZERO
73 ELSE
74 H21S = H( 2, 1 ) / S
75 V( 1 ) = H21S*H( 1, 2 ) + ( H( 1, 1 )-SR1 )*
76 $ ( ( H( 1, 1 )-SR2 ) / S ) - SI1*( SI2 / S )
77 V( 2 ) = H21S*( H( 1, 1 )+H( 2, 2 )-SR1-SR2 )
78 END IF
79 ELSE
80 S = ABS( H( 1, 1 )-SR2 ) + ABS( SI2 ) + ABS( H( 2, 1 ) ) +
81 $ ABS( H( 3, 1 ) )
82 IF( S.EQ.ZERO ) THEN
83 V( 1 ) = ZERO
84 V( 2 ) = ZERO
85 V( 3 ) = ZERO
86 ELSE
87 H21S = H( 2, 1 ) / S
88 H31S = H( 3, 1 ) / S
89 V( 1 ) = ( H( 1, 1 )-SR1 )*( ( H( 1, 1 )-SR2 ) / S ) -
90 $ SI1*( SI2 / S ) + H( 1, 2 )*H21S + H( 1, 3 )*H31S
91 V( 2 ) = H21S*( H( 1, 1 )+H( 2, 2 )-SR1-SR2 ) +
92 $ H( 2, 3 )*H31S
93 V( 3 ) = H31S*( H( 1, 1 )+H( 3, 3 )-SR1-SR2 ) +
94 $ H21S*H( 3, 2 )
95 END IF
96 END IF
97 END
2 *
3 * -- LAPACK auxiliary routine (version 3.2) --
4 * Univ. of Tennessee, Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..
5 * November 2006
6 *
7 * .. Scalar Arguments ..
8 DOUBLE PRECISION SI1, SI2, SR1, SR2
9 INTEGER LDH, N
10 * ..
11 * .. Array Arguments ..
12 DOUBLE PRECISION H( LDH, * ), V( * )
13 * ..
14 *
15 * Given a 2-by-2 or 3-by-3 matrix H, DLAQR1 sets v to a
16 * scalar multiple of the first column of the product
17 *
18 * (*) K = (H - (sr1 + i*si1)*I)*(H - (sr2 + i*si2)*I)
19 *
20 * scaling to avoid overflows and most underflows. It
21 * is assumed that either
22 *
23 * 1) sr1 = sr2 and si1 = -si2
24 * or
25 * 2) si1 = si2 = 0.
26 *
27 * This is useful for starting double implicit shift bulges
28 * in the QR algorithm.
29 *
30 *
31 * N (input) integer
32 * Order of the matrix H. N must be either 2 or 3.
33 *
34 * H (input) DOUBLE PRECISION array of dimension (LDH,N)
35 * The 2-by-2 or 3-by-3 matrix H in (*).
36 *
37 * LDH (input) integer
38 * The leading dimension of H as declared in
39 * the calling procedure. LDH.GE.N
40 *
41 * SR1 (input) DOUBLE PRECISION
42 * SI1 The shifts in (*).
43 * SR2
44 * SI2
45 *
46 * V (output) DOUBLE PRECISION array of dimension N
47 * A scalar multiple of the first column of the
48 * matrix K in (*).
49 *
50 * ================================================================
51 * Based on contributions by
52 * Karen Braman and Ralph Byers, Department of Mathematics,
53 * University of Kansas, USA
54 *
55 * ================================================================
56 *
57 * .. Parameters ..
58 DOUBLE PRECISION ZERO
59 PARAMETER ( ZERO = 0.0d0 )
60 * ..
61 * .. Local Scalars ..
62 DOUBLE PRECISION H21S, H31S, S
63 * ..
64 * .. Intrinsic Functions ..
65 INTRINSIC ABS
66 * ..
67 * .. Executable Statements ..
68 IF( N.EQ.2 ) THEN
69 S = ABS( H( 1, 1 )-SR2 ) + ABS( SI2 ) + ABS( H( 2, 1 ) )
70 IF( S.EQ.ZERO ) THEN
71 V( 1 ) = ZERO
72 V( 2 ) = ZERO
73 ELSE
74 H21S = H( 2, 1 ) / S
75 V( 1 ) = H21S*H( 1, 2 ) + ( H( 1, 1 )-SR1 )*
76 $ ( ( H( 1, 1 )-SR2 ) / S ) - SI1*( SI2 / S )
77 V( 2 ) = H21S*( H( 1, 1 )+H( 2, 2 )-SR1-SR2 )
78 END IF
79 ELSE
80 S = ABS( H( 1, 1 )-SR2 ) + ABS( SI2 ) + ABS( H( 2, 1 ) ) +
81 $ ABS( H( 3, 1 ) )
82 IF( S.EQ.ZERO ) THEN
83 V( 1 ) = ZERO
84 V( 2 ) = ZERO
85 V( 3 ) = ZERO
86 ELSE
87 H21S = H( 2, 1 ) / S
88 H31S = H( 3, 1 ) / S
89 V( 1 ) = ( H( 1, 1 )-SR1 )*( ( H( 1, 1 )-SR2 ) / S ) -
90 $ SI1*( SI2 / S ) + H( 1, 2 )*H21S + H( 1, 3 )*H31S
91 V( 2 ) = H21S*( H( 1, 1 )+H( 2, 2 )-SR1-SR2 ) +
92 $ H( 2, 3 )*H31S
93 V( 3 ) = H31S*( H( 1, 1 )+H( 3, 3 )-SR1-SR2 ) +
94 $ H21S*H( 3, 2 )
95 END IF
96 END IF
97 END