1*> \brief \b ZLAQR1 sets a scalar multiple of the first column of the product of 2-by-2 or 3-by-3 matrix H and specified shifts.
2*
3*  =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6*            http://www.netlib.org/lapack/explore-html/
7*
8*> \htmlonly
9*> Download ZLAQR1 + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zlaqr1.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zlaqr1.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zlaqr1.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18*  Definition:
19*  ===========
20*
21*       SUBROUTINE ZLAQR1( N, H, LDH, S1, S2, V )
22*
23*       .. Scalar Arguments ..
24*       COMPLEX*16         S1, S2
25*       INTEGER            LDH, N
26*       ..
27*       .. Array Arguments ..
28*       COMPLEX*16         H( LDH, * ), V( * )
29*       ..
30*
31*
32*> \par Purpose:
33*  =============
34*>
35*> \verbatim
36*>
37*>      Given a 2-by-2 or 3-by-3 matrix H, ZLAQR1 sets v to a
38*>      scalar multiple of the first column of the product
39*>
40*>      (*)  K = (H - s1*I)*(H - s2*I)
41*>
42*>      scaling to avoid overflows and most underflows.
43*>
44*>      This is useful for starting double implicit shift bulges
45*>      in the QR algorithm.
46*> \endverbatim
47*
48*  Arguments:
49*  ==========
50*
51*> \param[in] N
52*> \verbatim
53*>          N is INTEGER
54*>              Order of the matrix H. N must be either 2 or 3.
55*> \endverbatim
56*>
57*> \param[in] H
58*> \verbatim
59*>          H is COMPLEX*16 array, dimension (LDH,N)
60*>              The 2-by-2 or 3-by-3 matrix H in (*).
61*> \endverbatim
62*>
63*> \param[in] LDH
64*> \verbatim
65*>          LDH is INTEGER
66*>              The leading dimension of H as declared in
67*>              the calling procedure.  LDH >= N
68*> \endverbatim
69*>
70*> \param[in] S1
71*> \verbatim
72*>          S1 is COMPLEX*16
73*> \endverbatim
74*>
75*> \param[in] S2
76*> \verbatim
77*>          S2 is COMPLEX*16
78*>
79*>          S1 and S2 are the shifts defining K in (*) above.
80*> \endverbatim
81*>
82*> \param[out] V
83*> \verbatim
84*>          V is COMPLEX*16 array, dimension (N)
85*>              A scalar multiple of the first column of the
86*>              matrix K in (*).
87*> \endverbatim
88*
89*  Authors:
90*  ========
91*
92*> \author Univ. of Tennessee
93*> \author Univ. of California Berkeley
94*> \author Univ. of Colorado Denver
95*> \author NAG Ltd.
96*
97*> \ingroup complex16OTHERauxiliary
98*
99*> \par Contributors:
100*  ==================
101*>
102*>       Karen Braman and Ralph Byers, Department of Mathematics,
103*>       University of Kansas, USA
104*>
105*  =====================================================================
106      SUBROUTINE ZLAQR1( N, H, LDH, S1, S2, V )
107*
108*  -- LAPACK auxiliary routine --
109*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
110*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
111*
112*     .. Scalar Arguments ..
113      COMPLEX*16         S1, S2
114      INTEGER            LDH, N
115*     ..
116*     .. Array Arguments ..
117      COMPLEX*16         H( LDH, * ), V( * )
118*     ..
119*
120*  ================================================================
121*
122*     .. Parameters ..
123      COMPLEX*16         ZERO
124      PARAMETER          ( ZERO = ( 0.0d0, 0.0d0 ) )
125      DOUBLE PRECISION   RZERO
126      PARAMETER          ( RZERO = 0.0d0 )
127*     ..
128*     .. Local Scalars ..
129      COMPLEX*16         CDUM, H21S, H31S
130      DOUBLE PRECISION   S
131*     ..
132*     .. Intrinsic Functions ..
133      INTRINSIC          ABS, DBLE, DIMAG
134*     ..
135*     .. Statement Functions ..
136      DOUBLE PRECISION   CABS1
137*     ..
138*     .. Statement Function definitions ..
139      CABS1( CDUM ) = ABS( DBLE( CDUM ) ) + ABS( DIMAG( CDUM ) )
140*     ..
141*     .. Executable Statements ..
142*
143*     Quick return if possible
144*
145      IF( N.NE.2 .AND. N.NE.3 ) THEN
146         RETURN
147      END IF
148*
149      IF( N.EQ.2 ) THEN
150         S = CABS1( H( 1, 1 )-S2 ) + CABS1( H( 2, 1 ) )
151         IF( S.EQ.RZERO ) THEN
152            V( 1 ) = ZERO
153            V( 2 ) = ZERO
154         ELSE
155            H21S = H( 2, 1 ) / S
156            V( 1 ) = H21S*H( 1, 2 ) + ( H( 1, 1 )-S1 )*
157     $               ( ( H( 1, 1 )-S2 ) / S )
158            V( 2 ) = H21S*( H( 1, 1 )+H( 2, 2 )-S1-S2 )
159         END IF
160      ELSE
161         S = CABS1( H( 1, 1 )-S2 ) + CABS1( H( 2, 1 ) ) +
162     $       CABS1( H( 3, 1 ) )
163         IF( S.EQ.ZERO ) THEN
164            V( 1 ) = ZERO
165            V( 2 ) = ZERO
166            V( 3 ) = ZERO
167         ELSE
168            H21S = H( 2, 1 ) / S
169            H31S = H( 3, 1 ) / S
170            V( 1 ) = ( H( 1, 1 )-S1 )*( ( H( 1, 1 )-S2 ) / S ) +
171     $               H( 1, 2 )*H21S + H( 1, 3 )*H31S
172            V( 2 ) = H21S*( H( 1, 1 )+H( 2, 2 )-S1-S2 ) + H( 2, 3 )*H31S
173            V( 3 ) = H31S*( H( 1, 1 )+H( 3, 3 )-S1-S2 ) + H21S*H( 3, 2 )
174         END IF
175      END IF
176      END
177