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