Return to dlaqr1.f CVS log

Up to [local] / rpl / lapack / lapack

Cohérence

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