LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
zlaqr1.f
Go to the documentation of this file.
00001 *> \brief \b ZLAQR1
00002 *
00003 *  =========== DOCUMENTATION ===========
00004 *
00005 * Online html documentation available at 
00006 *            http://www.netlib.org/lapack/explore-html/ 
00007 *
00008 *> \htmlonly
00009 *> Download ZLAQR1 + dependencies 
00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zlaqr1.f"> 
00011 *> [TGZ]</a> 
00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zlaqr1.f"> 
00013 *> [ZIP]</a> 
00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zlaqr1.f"> 
00015 *> [TXT]</a>
00016 *> \endhtmlonly 
00017 *
00018 *  Definition:
00019 *  ===========
00020 *
00021 *       SUBROUTINE ZLAQR1( N, H, LDH, S1, S2, V )
00022 * 
00023 *       .. Scalar Arguments ..
00024 *       COMPLEX*16         S1, S2
00025 *       INTEGER            LDH, N
00026 *       ..
00027 *       .. Array Arguments ..
00028 *       COMPLEX*16         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, ZLAQR1 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*16 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*16
00073 *> \endverbatim
00074 *>
00075 *> \param[in] S2
00076 *> \verbatim
00077 *>          S2 is COMPLEX*16
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*16 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 complex16OTHERauxiliary
00100 *
00101 *> \par Contributors:
00102 *  ==================
00103 *>
00104 *>       Karen Braman and Ralph Byers, Department of Mathematics,
00105 *>       University of Kansas, USA
00106 *>
00107 *  =====================================================================
00108       SUBROUTINE ZLAQR1( 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*16         S1, S2
00117       INTEGER            LDH, N
00118 *     ..
00119 *     .. Array Arguments ..
00120       COMPLEX*16         H( LDH, * ), V( * )
00121 *     ..
00122 *
00123 *  ================================================================
00124 *
00125 *     .. Parameters ..
00126       COMPLEX*16         ZERO
00127       PARAMETER          ( ZERO = ( 0.0d0, 0.0d0 ) )
00128       DOUBLE PRECISION   RZERO
00129       PARAMETER          ( RZERO = 0.0d0 )
00130 *     ..
00131 *     .. Local Scalars ..
00132       COMPLEX*16         CDUM, H21S, H31S
00133       DOUBLE PRECISION   S
00134 *     ..
00135 *     .. Intrinsic Functions ..
00136       INTRINSIC          ABS, DBLE, DIMAG
00137 *     ..
00138 *     .. Statement Functions ..
00139       DOUBLE PRECISION   CABS1
00140 *     ..
00141 *     .. Statement Function definitions ..
00142       CABS1( CDUM ) = ABS( DBLE( CDUM ) ) + ABS( DIMAG( 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
 All Files Functions