![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b DLAQR1 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 *> \htmlonly 00009 *> Download DLAQR1 + dependencies 00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlaqr1.f"> 00011 *> [TGZ]</a> 00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlaqr1.f"> 00013 *> [ZIP]</a> 00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlaqr1.f"> 00015 *> [TXT]</a> 00016 *> \endhtmlonly 00017 * 00018 * Definition: 00019 * =========== 00020 * 00021 * SUBROUTINE DLAQR1( N, H, LDH, SR1, SI1, SR2, SI2, V ) 00022 * 00023 * .. Scalar Arguments .. 00024 * DOUBLE PRECISION SI1, SI2, SR1, SR2 00025 * INTEGER LDH, N 00026 * .. 00027 * .. Array Arguments .. 00028 * DOUBLE PRECISION H( LDH, * ), V( * ) 00029 * .. 00030 * 00031 * 00032 *> \par Purpose: 00033 * ============= 00034 *> 00035 *> \verbatim 00036 *> 00037 *> Given a 2-by-2 or 3-by-3 matrix H, DLAQR1 sets v to a 00038 *> scalar multiple of the first column of the product 00039 *> 00040 *> (*) K = (H - (sr1 + i*si1)*I)*(H - (sr2 + i*si2)*I) 00041 *> 00042 *> scaling to avoid overflows and most underflows. It 00043 *> is assumed that either 00044 *> 00045 *> 1) sr1 = sr2 and si1 = -si2 00046 *> or 00047 *> 2) si1 = si2 = 0. 00048 *> 00049 *> This is useful for starting double implicit shift bulges 00050 *> in the QR algorithm. 00051 *> \endverbatim 00052 * 00053 * Arguments: 00054 * ========== 00055 * 00056 *> \param[in] N 00057 *> \verbatim 00058 *> N is integer 00059 *> Order of the matrix H. N must be either 2 or 3. 00060 *> \endverbatim 00061 *> 00062 *> \param[in] H 00063 *> \verbatim 00064 *> H is DOUBLE PRECISION array of dimension (LDH,N) 00065 *> The 2-by-2 or 3-by-3 matrix H in (*). 00066 *> \endverbatim 00067 *> 00068 *> \param[in] LDH 00069 *> \verbatim 00070 *> LDH is integer 00071 *> The leading dimension of H as declared in 00072 *> the calling procedure. LDH.GE.N 00073 *> \endverbatim 00074 *> 00075 *> \param[in] SR1 00076 *> \verbatim 00077 *> SR1 is DOUBLE PRECISION 00078 *> \endverbatim 00079 *> 00080 *> \param[in] SI1 00081 *> \verbatim 00082 *> SI1 is DOUBLE PRECISION 00083 *> \endverbatim 00084 *> 00085 *> \param[in] SR2 00086 *> \verbatim 00087 *> SR2 is DOUBLE PRECISION 00088 *> \endverbatim 00089 *> 00090 *> \param[in] SI2 00091 *> \verbatim 00092 *> SI2 is DOUBLE PRECISION 00093 *> The shifts in (*). 00094 *> \endverbatim 00095 *> 00096 *> \param[out] V 00097 *> \verbatim 00098 *> V is DOUBLE PRECISION array of dimension N 00099 *> A scalar multiple of the first column of the 00100 *> matrix K in (*). 00101 *> \endverbatim 00102 * 00103 * Authors: 00104 * ======== 00105 * 00106 *> \author Univ. of Tennessee 00107 *> \author Univ. of California Berkeley 00108 *> \author Univ. of Colorado Denver 00109 *> \author NAG Ltd. 00110 * 00111 *> \date November 2011 00112 * 00113 *> \ingroup doubleOTHERauxiliary 00114 * 00115 *> \par Contributors: 00116 * ================== 00117 *> 00118 *> Karen Braman and Ralph Byers, Department of Mathematics, 00119 *> University of Kansas, USA 00120 *> 00121 * ===================================================================== 00122 SUBROUTINE DLAQR1( N, H, LDH, SR1, SI1, SR2, SI2, V ) 00123 * 00124 * -- LAPACK auxiliary routine (version 3.4.0) -- 00125 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00126 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00127 * November 2011 00128 * 00129 * .. Scalar Arguments .. 00130 DOUBLE PRECISION SI1, SI2, SR1, SR2 00131 INTEGER LDH, N 00132 * .. 00133 * .. Array Arguments .. 00134 DOUBLE PRECISION H( LDH, * ), V( * ) 00135 * .. 00136 * 00137 * ================================================================ 00138 * 00139 * .. Parameters .. 00140 DOUBLE PRECISION ZERO 00141 PARAMETER ( ZERO = 0.0d0 ) 00142 * .. 00143 * .. Local Scalars .. 00144 DOUBLE PRECISION H21S, H31S, S 00145 * .. 00146 * .. Intrinsic Functions .. 00147 INTRINSIC ABS 00148 * .. 00149 * .. Executable Statements .. 00150 IF( N.EQ.2 ) THEN 00151 S = ABS( H( 1, 1 )-SR2 ) + ABS( SI2 ) + ABS( H( 2, 1 ) ) 00152 IF( S.EQ.ZERO ) THEN 00153 V( 1 ) = ZERO 00154 V( 2 ) = ZERO 00155 ELSE 00156 H21S = H( 2, 1 ) / S 00157 V( 1 ) = H21S*H( 1, 2 ) + ( H( 1, 1 )-SR1 )* 00158 $ ( ( H( 1, 1 )-SR2 ) / S ) - SI1*( SI2 / S ) 00159 V( 2 ) = H21S*( H( 1, 1 )+H( 2, 2 )-SR1-SR2 ) 00160 END IF 00161 ELSE 00162 S = ABS( H( 1, 1 )-SR2 ) + ABS( SI2 ) + ABS( H( 2, 1 ) ) + 00163 $ ABS( H( 3, 1 ) ) 00164 IF( S.EQ.ZERO ) THEN 00165 V( 1 ) = ZERO 00166 V( 2 ) = ZERO 00167 V( 3 ) = ZERO 00168 ELSE 00169 H21S = H( 2, 1 ) / S 00170 H31S = H( 3, 1 ) / S 00171 V( 1 ) = ( H( 1, 1 )-SR1 )*( ( H( 1, 1 )-SR2 ) / S ) - 00172 $ SI1*( SI2 / S ) + H( 1, 2 )*H21S + H( 1, 3 )*H31S 00173 V( 2 ) = H21S*( H( 1, 1 )+H( 2, 2 )-SR1-SR2 ) + 00174 $ H( 2, 3 )*H31S 00175 V( 3 ) = H31S*( H( 1, 1 )+H( 3, 3 )-SR1-SR2 ) + 00176 $ H21S*H( 3, 2 ) 00177 END IF 00178 END IF 00179 END