d7/d1c/claqr1_8f_source.html

00001       SUBROUTINE CLAQR1( 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            S1, S2
00009       INTEGER            LDH, N
00010 *     ..
00011 *     .. Array Arguments ..
00012       COMPLEX            H( LDH, * ), V( * )
00013 *     ..
00014 *
00015 *       Given a 2-by-2 or 3-by-3 matrix H, CLAQR1 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 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
00037 *       S2     S1 and S2 are the shifts defining K in (*) above.
00038 *
00039 *       V      (output) COMPLEX 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            ZERO
00052       PARAMETER          ( ZERO = ( 0.0e0, 0.0e0 ) )
00053       REAL               RZERO
00054       PARAMETER          ( RZERO = 0.0e0 )
00055 *     ..
00056 *     .. Local Scalars ..
00057       COMPLEX            CDUM, H21S, H31S
00058       REAL               S
00059 *     ..
00060 *     .. Intrinsic Functions ..
00061       INTRINSIC          ABS, AIMAG, REAL
00062 *     ..
00063 *     .. Statement Functions ..
00064       REAL               CABS1
00065 *     ..
00066 *     .. Statement Function definitions ..
00067       CABS1( CDUM ) = ABS( REAL( CDUM ) ) + ABS( AIMAG( 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