SRC/claqr1.f

   1 *> \brief \b CLAQR1 sets a scalar multiple of the first column of the product of 2-by-2 or 3-by-3 matrix H and specified shifts.
   2 *
   3 *  =========== DOCUMENTATION ===========
   4 *
   5 * Online html documentation available at
   6 *            http://www.netlib.org/lapack/explore-html/
   7 *
   8 *> \htmlonly
   9 *> Download CLAQR1 + dependencies
  10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/claqr1.f">
  11 *> [TGZ]</a>
  12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/claqr1.f">
  13 *> [ZIP]</a>
  14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/claqr1.f">
  15 *> [TXT]</a>
  16 *> \endhtmlonly
  17 *
  18 *  Definition:
  19 *  ===========
  20 *
  21 *       SUBROUTINE CLAQR1( N, H, LDH, S1, S2, V )
  22 *
  23 *       .. Scalar Arguments ..
  24 *       COMPLEX            S1, S2
  25 *       INTEGER            LDH, N
  26 *       ..
  27 *       .. Array Arguments ..
  28 *       COMPLEX            H( LDH, * ), V( * )
  29 *       ..
  30 *
  31 *
  32 *> \par Purpose:
  33 *  =============
  34 *>
  35 *> \verbatim
  36 *>
  37 *>      Given a 2-by-2 or 3-by-3 matrix H, CLAQR1 sets v to a
  38 *>      scalar multiple of the first column of the product
  39 *>
  40 *>      (*)  K = (H - s1*I)*(H - s2*I)
  41 *>
  42 *>      scaling to avoid overflows and most underflows.
  43 *>
  44 *>      This is useful for starting double implicit shift bulges
  45 *>      in the QR algorithm.
  46 *> \endverbatim
  47 *
  48 *  Arguments:
  49 *  ==========
  50 *
  51 *> \param[in] N
  52 *> \verbatim
  53 *>          N is integer
  54 *>              Order of the matrix H. N must be either 2 or 3.
  55 *> \endverbatim
  56 *>
  57 *> \param[in] H
  58 *> \verbatim
  59 *>          H is COMPLEX array of dimension (LDH,N)
  60 *>              The 2-by-2 or 3-by-3 matrix H in (*).
  61 *> \endverbatim
  62 *>
  63 *> \param[in] LDH
  64 *> \verbatim
  65 *>          LDH is integer
  66 *>              The leading dimension of H as declared in
  67 *>              the calling procedure.  LDH.GE.N
  68 *> \endverbatim
  69 *>
  70 *> \param[in] S1
  71 *> \verbatim
  72 *>          S1 is COMPLEX
  73 *> \endverbatim
  74 *>
  75 *> \param[in] S2
  76 *> \verbatim
  77 *>          S2 is COMPLEX
  78 *>
  79 *>          S1 and S2 are the shifts defining K in (*) above.
  80 *> \endverbatim
  81 *>
  82 *> \param[out] V
  83 *> \verbatim
  84 *>          V is COMPLEX array of dimension N
  85 *>              A scalar multiple of the first column of the
  86 *>              matrix K in (*).
  87 *> \endverbatim
  88 *
  89 *  Authors:
  90 *  ========
  91 *
  92 *> \author Univ. of Tennessee
  93 *> \author Univ. of California Berkeley
  94 *> \author Univ. of Colorado Denver
  95 *> \author NAG Ltd.
  96 *
  97 *> \date September 2012
  98 *
  99 *> \ingroup complexOTHERauxiliary
 100 *
 101 *> \par Contributors:
 102 *  ==================
 103 *>
 104 *>       Karen Braman and Ralph Byers, Department of Mathematics,
 105 *>       University of Kansas, USA
 106 *>
 107 *  =====================================================================
 108       SUBROUTINE CLAQR1( N, H, LDH, S1, S2, V )
 109 *
 110 *  -- LAPACK auxiliary routine (version 3.4.2) --
 111 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 112 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 113 *     September 2012
 114 *
 115 *     .. Scalar Arguments ..
 116       COMPLEX            S1, S2
 117       INTEGER            LDH, N
 118 *     ..
 119 *     .. Array Arguments ..
 120       COMPLEX            H( LDH, * ), V( * )
 121 *     ..
 122 *
 123 *  ================================================================
 124 *
 125 *     .. Parameters ..
 126       COMPLEX            ZERO
 127       PARAMETER          ( ZERO = ( 0.0e0, 0.0e0 ) )
 128       REAL               RZERO
 129       PARAMETER          ( RZERO = 0.0e0 )
 130 *     ..
 131 *     .. Local Scalars ..
 132       COMPLEX            CDUM, H21S, H31S
 133       REAL               S
 134 *     ..
 135 *     .. Intrinsic Functions ..
 136       INTRINSIC          ABS, AIMAG, REAL
 137 *     ..
 138 *     .. Statement Functions ..
 139       REAL               CABS1
 140 *     ..
 141 *     .. Statement Function definitions ..
 142       CABS1( CDUM ) = ABS( REAL( CDUM ) ) + ABS( AIMAG( CDUM ) )
 143 *     ..
 144 *     .. Executable Statements ..
 145       IF( N.EQ.2 ) THEN
 146          S = CABS1( H( 1, 1 )-S2 ) + CABS1( H( 2, 1 ) )
 147          IF( S.EQ.RZERO ) THEN
 148             V( 1 ) = ZERO
 149             V( 2 ) = ZERO
 150          ELSE
 151             H21S = H( 2, 1 ) / S
 152             V( 1 ) = H21S*H( 1, 2 ) + ( H( 1, 1 )-S1 )*
 153      $               ( ( H( 1, 1 )-S2 ) / S )
 154             V( 2 ) = H21S*( H( 1, 1 )+H( 2, 2 )-S1-S2 )
 155          END IF
 156       ELSE
 157          S = CABS1( H( 1, 1 )-S2 ) + CABS1( H( 2, 1 ) ) +
 158      $       CABS1( H( 3, 1 ) )
 159          IF( S.EQ.ZERO ) THEN
 160             V( 1 ) = ZERO
 161             V( 2 ) = ZERO
 162             V( 3 ) = ZERO
 163          ELSE
 164             H21S = H( 2, 1 ) / S
 165             H31S = H( 3, 1 ) / S
 166             V( 1 ) = ( H( 1, 1 )-S1 )*( ( H( 1, 1 )-S2 ) / S ) +
 167      $               H( 1, 2 )*H21S + H( 1, 3 )*H31S
 168             V( 2 ) = H21S*( H( 1, 1 )+H( 2, 2 )-S1-S2 ) + H( 2, 3 )*H31S
 169             V( 3 ) = H31S*( H( 1, 1 )+H( 3, 3 )-S1-S2 ) + H21S*H( 3, 2 )
 170          END IF
 171       END IF
 172       END