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