SRC/dgehd2.f

   1 *> \brief \b DGEHD2 reduces a general square matrix to upper Hessenberg form using an unblocked algorithm.
   2 *
   3 *  =========== DOCUMENTATION ===========
   4 *
   5 * Online html documentation available at
   6 *            http://www.netlib.org/lapack/explore-html/
   7 *
   8 *> \htmlonly
   9 *> Download DGEHD2 + dependencies
  10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgehd2.f">
  11 *> [TGZ]</a>
  12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgehd2.f">
  13 *> [ZIP]</a>
  14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgehd2.f">
  15 *> [TXT]</a>
  16 *> \endhtmlonly
  17 *
  18 *  Definition:
  19 *  ===========
  20 *
  21 *       SUBROUTINE DGEHD2( N, ILO, IHI, A, LDA, TAU, WORK, INFO )
  22 *
  23 *       .. Scalar Arguments ..
  24 *       INTEGER            IHI, ILO, INFO, LDA, N
  25 *       ..
  26 *       .. Array Arguments ..
  27 *       DOUBLE PRECISION   A( LDA, * ), TAU( * ), WORK( * )
  28 *       ..
  29 *
  30 *
  31 *> \par Purpose:
  32 *  =============
  33 *>
  34 *> \verbatim
  35 *>
  36 *> DGEHD2 reduces a real general matrix A to upper Hessenberg form H by
  37 *> an orthogonal similarity transformation:  Q**T * A * Q = H .
  38 *> \endverbatim
  39 *
  40 *  Arguments:
  41 *  ==========
  42 *
  43 *> \param[in] N
  44 *> \verbatim
  45 *>          N is INTEGER
  46 *>          The order of the matrix A.  N >= 0.
  47 *> \endverbatim
  48 *>
  49 *> \param[in] ILO
  50 *> \verbatim
  51 *>          ILO is INTEGER
  52 *> \endverbatim
  53 *>
  54 *> \param[in] IHI
  55 *> \verbatim
  56 *>          IHI is INTEGER
  57 *>
  58 *>          It is assumed that A is already upper triangular in rows
  59 *>          and columns 1:ILO-1 and IHI+1:N. ILO and IHI are normally
  60 *>          set by a previous call to DGEBAL; otherwise they should be
  61 *>          set to 1 and N respectively. See Further Details.
  62 *>          1 <= ILO <= IHI <= max(1,N).
  63 *> \endverbatim
  64 *>
  65 *> \param[in,out] A
  66 *> \verbatim
  67 *>          A is DOUBLE PRECISION array, dimension (LDA,N)
  68 *>          On entry, the n by n general matrix to be reduced.
  69 *>          On exit, the upper triangle and the first subdiagonal of A
  70 *>          are overwritten with the upper Hessenberg matrix H, and the
  71 *>          elements below the first subdiagonal, with the array TAU,
  72 *>          represent the orthogonal matrix Q as a product of elementary
  73 *>          reflectors. See Further Details.
  74 *> \endverbatim
  75 *>
  76 *> \param[in] LDA
  77 *> \verbatim
  78 *>          LDA is INTEGER
  79 *>          The leading dimension of the array A.  LDA >= max(1,N).
  80 *> \endverbatim
  81 *>
  82 *> \param[out] TAU
  83 *> \verbatim
  84 *>          TAU is DOUBLE PRECISION array, dimension (N-1)
  85 *>          The scalar factors of the elementary reflectors (see Further
  86 *>          Details).
  87 *> \endverbatim
  88 *>
  89 *> \param[out] WORK
  90 *> \verbatim
  91 *>          WORK is DOUBLE PRECISION array, dimension (N)
  92 *> \endverbatim
  93 *>
  94 *> \param[out] INFO
  95 *> \verbatim
  96 *>          INFO is INTEGER
  97 *>          = 0:  successful exit.
  98 *>          < 0:  if INFO = -i, the i-th argument had an illegal value.
  99 *> \endverbatim
 100 *
 101 *  Authors:
 102 *  ========
 103 *
 104 *> \author Univ. of Tennessee
 105 *> \author Univ. of California Berkeley
 106 *> \author Univ. of Colorado Denver
 107 *> \author NAG Ltd.
 108 *
 109 *> \date September 2012
 110 *
 111 *> \ingroup doubleGEcomputational
 112 *
 113 *> \par Further Details:
 114 *  =====================
 115 *>
 116 *> \verbatim
 117 *>
 118 *>  The matrix Q is represented as a product of (ihi-ilo) elementary
 119 *>  reflectors
 120 *>
 121 *>     Q = H(ilo) H(ilo+1) . . . H(ihi-1).
 122 *>
 123 *>  Each H(i) has the form
 124 *>
 125 *>     H(i) = I - tau * v * v**T
 126 *>
 127 *>  where tau is a real scalar, and v is a real vector with
 128 *>  v(1:i) = 0, v(i+1) = 1 and v(ihi+1:n) = 0; v(i+2:ihi) is stored on
 129 *>  exit in A(i+2:ihi,i), and tau in TAU(i).
 130 *>
 131 *>  The contents of A are illustrated by the following example, with
 132 *>  n = 7, ilo = 2 and ihi = 6:
 133 *>
 134 *>  on entry,                        on exit,
 135 *>
 136 *>  ( a   a   a   a   a   a   a )    (  a   a   h   h   h   h   a )
 137 *>  (     a   a   a   a   a   a )    (      a   h   h   h   h   a )
 138 *>  (     a   a   a   a   a   a )    (      h   h   h   h   h   h )
 139 *>  (     a   a   a   a   a   a )    (      v2  h   h   h   h   h )
 140 *>  (     a   a   a   a   a   a )    (      v2  v3  h   h   h   h )
 141 *>  (     a   a   a   a   a   a )    (      v2  v3  v4  h   h   h )
 142 *>  (                         a )    (                          a )
 143 *>
 144 *>  where a denotes an element of the original matrix A, h denotes a
 145 *>  modified element of the upper Hessenberg matrix H, and vi denotes an
 146 *>  element of the vector defining H(i).
 147 *> \endverbatim
 148 *>
 149 *  =====================================================================
 150       SUBROUTINE DGEHD2( N, ILO, IHI, A, LDA, TAU, WORK, INFO )
 151 *
 152 *  -- LAPACK computational routine (version 3.4.2) --
 153 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 154 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 155 *     September 2012
 156 *
 157 *     .. Scalar Arguments ..
 158       INTEGER            IHI, ILO, INFO, LDA, N
 159 *     ..
 160 *     .. Array Arguments ..
 161       DOUBLE PRECISION   A( LDA, * ), TAU( * ), WORK( * )
 162 *     ..
 163 *
 164 *  =====================================================================
 165 *
 166 *     .. Parameters ..
 167       DOUBLE PRECISION   ONE
 168       PARAMETER          ( ONE = 1.0D+0 )
 169 *     ..
 170 *     .. Local Scalars ..
 171       INTEGER            I
 172       DOUBLE PRECISION   AII
 173 *     ..
 174 *     .. External Subroutines ..
 175       EXTERNAL           DLARF, DLARFG, XERBLA
 176 *     ..
 177 *     .. Intrinsic Functions ..
 178       INTRINSIC          MAX, MIN
 179 *     ..
 180 *     .. Executable Statements ..
 181 *
 182 *     Test the input parameters
 183 *
 184       INFO = 0
 185       IF( N.LT.0 ) THEN
 186          INFO = -1
 187       ELSE IF( ILO.LT.1 .OR. ILO.GT.MAX( 1, N ) ) THEN
 188          INFO = -2
 189       ELSE IF( IHI.LT.MIN( ILO, N ) .OR. IHI.GT.N ) THEN
 190          INFO = -3
 191       ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
 192          INFO = -5
 193       END IF
 194       IF( INFO.NE.0 ) THEN
 195          CALL XERBLA( 'DGEHD2', -INFO )
 196          RETURN
 197       END IF
 198 *
 199       DO 10 I = ILO, IHI - 1
 200 *
 201 *        Compute elementary reflector H(i) to annihilate A(i+2:ihi,i)
 202 *
 203          CALL DLARFG( IHI-I, A( I+1, I ), A( MIN( I+2, N ), I ), 1,
 204      $                TAU( I ) )
 205          AII = A( I+1, I )
 206          A( I+1, I ) = ONE
 207 *
 208 *        Apply H(i) to A(1:ihi,i+1:ihi) from the right
 209 *
 210          CALL DLARF( 'Right', IHI, IHI-I, A( I+1, I ), 1, TAU( I ),
 211      $               A( 1, I+1 ), LDA, WORK )
 212 *
 213 *        Apply H(i) to A(i+1:ihi,i+1:n) from the left
 214 *
 215          CALL DLARF( 'Left', IHI-I, N-I, A( I+1, I ), 1, TAU( I ),
 216      $               A( I+1, I+1 ), LDA, WORK )
 217 *
 218          A( I+1, I ) = AII
 219    10 CONTINUE
 220 *
 221       RETURN
 222 *
 223 *     End of DGEHD2
 224 *
 225       END