 |
LAPACK 3.3.1
Linear Algebra PACKage
|
|
LAPACK 3.3.1
Linear Algebra PACKage
|
00001 SUBROUTINE ZLAQR1( N, H, LDH, S1, S2, 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 COMPLEX*16 S1, S2 00009 INTEGER LDH, N 00010 * .. 00011 * .. Array Arguments .. 00012 COMPLEX*16 H( LDH, * ), V( * ) 00013 * .. 00014 * 00015 * Given a 2-by-2 or 3-by-3 matrix H, ZLAQR1 sets v to a 00016 * scalar multiple of the first column of the product 00017 * 00018 * (*) K = (H - s1*I)*(H - s2*I) 00019 * 00020 * scaling to avoid overflows and most underflows. 00021 * 00022 * This is useful for starting double implicit shift bulges 00023 * in the QR algorithm. 00024 * 00025 * 00026 * N (input) integer 00027 * Order of the matrix H. N must be either 2 or 3. 00028 * 00029 * H (input) COMPLEX*16 array of dimension (LDH,N) 00030 * The 2-by-2 or 3-by-3 matrix H in (*). 00031 * 00032 * LDH (input) integer 00033 * The leading dimension of H as declared in 00034 * the calling procedure. LDH.GE.N 00035 * 00036 * S1 (input) COMPLEX*16 00037 * S2 S1 and S2 are the shifts defining K in (*) above. 00038 * 00039 * V (output) COMPLEX*16 array of dimension N 00040 * A scalar multiple of the first column of the 00041 * matrix K in (*). 00042 * 00043 * ================================================================ 00044 * Based on contributions by 00045 * Karen Braman and Ralph Byers, Department of Mathematics, 00046 * University of Kansas, USA 00047 * 00048 * ================================================================ 00049 * 00050 * .. Parameters .. 00051 COMPLEX*16 ZERO 00052 PARAMETER ( ZERO = ( 0.0d0, 0.0d0 ) ) 00053 DOUBLE PRECISION RZERO 00054 PARAMETER ( RZERO = 0.0d0 ) 00055 * .. 00056 * .. Local Scalars .. 00057 COMPLEX*16 CDUM, H21S, H31S 00058 DOUBLE PRECISION S 00059 * .. 00060 * .. Intrinsic Functions .. 00061 INTRINSIC ABS, DBLE, DIMAG 00062 * .. 00063 * .. Statement Functions .. 00064 DOUBLE PRECISION CABS1 00065 * .. 00066 * .. Statement Function definitions .. 00067 CABS1( CDUM ) = ABS( DBLE( CDUM ) ) + ABS( DIMAG( CDUM ) ) 00068 * .. 00069 * .. Executable Statements .. 00070 IF( N.EQ.2 ) THEN 00071 S = CABS1( H( 1, 1 )-S2 ) + CABS1( H( 2, 1 ) ) 00072 IF( S.EQ.RZERO ) THEN 00073 V( 1 ) = ZERO 00074 V( 2 ) = ZERO 00075 ELSE 00076 H21S = H( 2, 1 ) / S 00077 V( 1 ) = H21S*H( 1, 2 ) + ( H( 1, 1 )-S1 )* 00078 $ ( ( H( 1, 1 )-S2 ) / S ) 00079 V( 2 ) = H21S*( H( 1, 1 )+H( 2, 2 )-S1-S2 ) 00080 END IF 00081 ELSE 00082 S = CABS1( H( 1, 1 )-S2 ) + CABS1( H( 2, 1 ) ) + 00083 $ CABS1( H( 3, 1 ) ) 00084 IF( S.EQ.ZERO ) THEN 00085 V( 1 ) = ZERO 00086 V( 2 ) = ZERO 00087 V( 3 ) = ZERO 00088 ELSE 00089 H21S = H( 2, 1 ) / S 00090 H31S = H( 3, 1 ) / S 00091 V( 1 ) = ( H( 1, 1 )-S1 )*( ( H( 1, 1 )-S2 ) / S ) + 00092 $ H( 1, 2 )*H21S + H( 1, 3 )*H31S 00093 V( 2 ) = H21S*( H( 1, 1 )+H( 2, 2 )-S1-S2 ) + H( 2, 3 )*H31S 00094 V( 3 ) = H31S*( H( 1, 1 )+H( 3, 3 )-S1-S2 ) + H21S*H( 3, 2 ) 00095 END IF 00096 END IF 00097 END
1.7.3 
