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