 |
LAPACK 3.3.1
Linear Algebra PACKage
|
|
LAPACK 3.3.1
Linear Algebra PACKage
|
00001 SUBROUTINE DLAQR1( N, H, LDH, SR1, SI1, SR2, SI2, V ) 00002 * 00003 * -- LAPACK auxiliary routine (version 3.2) -- 00004 * Univ. of Tennessee, Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd.. 00005 * November 2006 00006 * 00007 * .. Scalar Arguments .. 00008 DOUBLE PRECISION SI1, SI2, SR1, SR2 00009 INTEGER LDH, N 00010 * .. 00011 * .. Array Arguments .. 00012 DOUBLE PRECISION H( LDH, * ), V( * ) 00013 * .. 00014 * 00015 * Given a 2-by-2 or 3-by-3 matrix H, DLAQR1 sets v to a 00016 * scalar multiple of the first column of the product 00017 * 00018 * (*) K = (H - (sr1 + i*si1)*I)*(H - (sr2 + i*si2)*I) 00019 * 00020 * scaling to avoid overflows and most underflows. It 00021 * is assumed that either 00022 * 00023 * 1) sr1 = sr2 and si1 = -si2 00024 * or 00025 * 2) si1 = si2 = 0. 00026 * 00027 * This is useful for starting double implicit shift bulges 00028 * in the QR algorithm. 00029 * 00030 * 00031 * N (input) integer 00032 * Order of the matrix H. N must be either 2 or 3. 00033 * 00034 * H (input) DOUBLE PRECISION array of dimension (LDH,N) 00035 * The 2-by-2 or 3-by-3 matrix H in (*). 00036 * 00037 * LDH (input) integer 00038 * The leading dimension of H as declared in 00039 * the calling procedure. LDH.GE.N 00040 * 00041 * SR1 (input) DOUBLE PRECISION 00042 * SI1 The shifts in (*). 00043 * SR2 00044 * SI2 00045 * 00046 * V (output) DOUBLE PRECISION array of dimension N 00047 * A scalar multiple of the first column of the 00048 * matrix K in (*). 00049 * 00050 * ================================================================ 00051 * Based on contributions by 00052 * Karen Braman and Ralph Byers, Department of Mathematics, 00053 * University of Kansas, USA 00054 * 00055 * ================================================================ 00056 * 00057 * .. Parameters .. 00058 DOUBLE PRECISION ZERO 00059 PARAMETER ( ZERO = 0.0d0 ) 00060 * .. 00061 * .. Local Scalars .. 00062 DOUBLE PRECISION H21S, H31S, S 00063 * .. 00064 * .. Intrinsic Functions .. 00065 INTRINSIC ABS 00066 * .. 00067 * .. Executable Statements .. 00068 IF( N.EQ.2 ) THEN 00069 S = ABS( H( 1, 1 )-SR2 ) + ABS( SI2 ) + ABS( H( 2, 1 ) ) 00070 IF( S.EQ.ZERO ) THEN 00071 V( 1 ) = ZERO 00072 V( 2 ) = ZERO 00073 ELSE 00074 H21S = H( 2, 1 ) / S 00075 V( 1 ) = H21S*H( 1, 2 ) + ( H( 1, 1 )-SR1 )* 00076 $ ( ( H( 1, 1 )-SR2 ) / S ) - SI1*( SI2 / S ) 00077 V( 2 ) = H21S*( H( 1, 1 )+H( 2, 2 )-SR1-SR2 ) 00078 END IF 00079 ELSE 00080 S = ABS( H( 1, 1 )-SR2 ) + ABS( SI2 ) + ABS( H( 2, 1 ) ) + 00081 $ ABS( H( 3, 1 ) ) 00082 IF( S.EQ.ZERO ) THEN 00083 V( 1 ) = ZERO 00084 V( 2 ) = ZERO 00085 V( 3 ) = ZERO 00086 ELSE 00087 H21S = H( 2, 1 ) / S 00088 H31S = H( 3, 1 ) / S 00089 V( 1 ) = ( H( 1, 1 )-SR1 )*( ( H( 1, 1 )-SR2 ) / S ) - 00090 $ SI1*( SI2 / S ) + H( 1, 2 )*H21S + H( 1, 3 )*H31S 00091 V( 2 ) = H21S*( H( 1, 1 )+H( 2, 2 )-SR1-SR2 ) + 00092 $ H( 2, 3 )*H31S 00093 V( 3 ) = H31S*( H( 1, 1 )+H( 3, 3 )-SR1-SR2 ) + 00094 $ H21S*H( 3, 2 ) 00095 END IF 00096 END IF 00097 END
1.7.3 
