1*> \brief \b DLAQR1 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 DLAQR1 + dependencies 10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlaqr1.f"> 11*> [TGZ]</a> 12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlaqr1.f"> 13*> [ZIP]</a> 14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlaqr1.f"> 15*> [TXT]</a> 16*> \endhtmlonly 17* 18* Definition: 19* =========== 20* 21* SUBROUTINE DLAQR1( N, H, LDH, SR1, SI1, SR2, SI2, V ) 22* 23* .. Scalar Arguments .. 24* DOUBLE PRECISION SI1, SI2, SR1, SR2 25* INTEGER LDH, N 26* .. 27* .. Array Arguments .. 28* DOUBLE PRECISION 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, DLAQR1 sets v to a 38*> scalar multiple of the first column of the product 39*> 40*> (*) K = (H - (sr1 + i*si1)*I)*(H - (sr2 + i*si2)*I) 41*> 42*> scaling to avoid overflows and most underflows. It 43*> is assumed that either 44*> 45*> 1) sr1 = sr2 and si1 = -si2 46*> or 47*> 2) si1 = si2 = 0. 48*> 49*> This is useful for starting double implicit shift bulges 50*> in the QR algorithm. 51*> \endverbatim 52* 53* Arguments: 54* ========== 55* 56*> \param[in] N 57*> \verbatim 58*> N is integer 59*> Order of the matrix H. N must be either 2 or 3. 60*> \endverbatim 61*> 62*> \param[in] H 63*> \verbatim 64*> H is DOUBLE PRECISION array of dimension (LDH,N) 65*> The 2-by-2 or 3-by-3 matrix H in (*). 66*> \endverbatim 67*> 68*> \param[in] LDH 69*> \verbatim 70*> LDH is integer 71*> The leading dimension of H as declared in 72*> the calling procedure. LDH.GE.N 73*> \endverbatim 74*> 75*> \param[in] SR1 76*> \verbatim 77*> SR1 is DOUBLE PRECISION 78*> \endverbatim 79*> 80*> \param[in] SI1 81*> \verbatim 82*> SI1 is DOUBLE PRECISION 83*> \endverbatim 84*> 85*> \param[in] SR2 86*> \verbatim 87*> SR2 is DOUBLE PRECISION 88*> \endverbatim 89*> 90*> \param[in] SI2 91*> \verbatim 92*> SI2 is DOUBLE PRECISION 93*> The shifts in (*). 94*> \endverbatim 95*> 96*> \param[out] V 97*> \verbatim 98*> V is DOUBLE PRECISION array of dimension N 99*> A scalar multiple of the first column of the 100*> matrix K in (*). 101*> \endverbatim 102* 103* Authors: 104* ======== 105* 106*> \author Univ. of Tennessee 107*> \author Univ. of California Berkeley 108*> \author Univ. of Colorado Denver 109*> \author NAG Ltd. 110* 111*> \date September 2012 112* 113*> \ingroup doubleOTHERauxiliary 114* 115*> \par Contributors: 116* ================== 117*> 118*> Karen Braman and Ralph Byers, Department of Mathematics, 119*> University of Kansas, USA 120*> 121* ===================================================================== 122 SUBROUTINE DLAQR1( N, H, LDH, SR1, SI1, SR2, SI2, V ) 123* 124* -- LAPACK auxiliary routine (version 3.4.2) -- 125* -- LAPACK is a software package provided by Univ. of Tennessee, -- 126* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 127* September 2012 128* 129* .. Scalar Arguments .. 130 DOUBLE PRECISION SI1, SI2, SR1, SR2 131 INTEGER LDH, N 132* .. 133* .. Array Arguments .. 134 DOUBLE PRECISION H( LDH, * ), V( * ) 135* .. 136* 137* ================================================================ 138* 139* .. Parameters .. 140 DOUBLE PRECISION ZERO 141 PARAMETER ( ZERO = 0.0d0 ) 142* .. 143* .. Local Scalars .. 144 DOUBLE PRECISION H21S, H31S, S 145* .. 146* .. Intrinsic Functions .. 147 INTRINSIC ABS 148* .. 149* .. Executable Statements .. 150 IF( N.EQ.2 ) THEN 151 S = ABS( H( 1, 1 )-SR2 ) + ABS( SI2 ) + ABS( H( 2, 1 ) ) 152 IF( S.EQ.ZERO ) THEN 153 V( 1 ) = ZERO 154 V( 2 ) = ZERO 155 ELSE 156 H21S = H( 2, 1 ) / S 157 V( 1 ) = H21S*H( 1, 2 ) + ( H( 1, 1 )-SR1 )* 158 $ ( ( H( 1, 1 )-SR2 ) / S ) - SI1*( SI2 / S ) 159 V( 2 ) = H21S*( H( 1, 1 )+H( 2, 2 )-SR1-SR2 ) 160 END IF 161 ELSE 162 S = ABS( H( 1, 1 )-SR2 ) + ABS( SI2 ) + ABS( H( 2, 1 ) ) + 163 $ ABS( H( 3, 1 ) ) 164 IF( S.EQ.ZERO ) THEN 165 V( 1 ) = ZERO 166 V( 2 ) = ZERO 167 V( 3 ) = ZERO 168 ELSE 169 H21S = H( 2, 1 ) / S 170 H31S = H( 3, 1 ) / S 171 V( 1 ) = ( H( 1, 1 )-SR1 )*( ( H( 1, 1 )-SR2 ) / S ) - 172 $ SI1*( SI2 / S ) + H( 1, 2 )*H21S + H( 1, 3 )*H31S 173 V( 2 ) = H21S*( H( 1, 1 )+H( 2, 2 )-SR1-SR2 ) + 174 $ H( 2, 3 )*H31S 175 V( 3 ) = H31S*( H( 1, 1 )+H( 3, 3 )-SR1-SR2 ) + 176 $ H21S*H( 3, 2 ) 177 END IF 178 END IF 179 END 180