slasd5.f

Go to the documentation of this file.

*> \brief \b SLASD5 computes the square root of the i-th eigenvalue of a positive symmetric rank-one modification of a 2-by-2 diagonal matrix. Used by sbdsdc.
*
*  =========== DOCUMENTATION ===========
*
* Online html documentation available at
*            http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download SLASD5 + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slasd5.f">
*> [TGZ]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slasd5.f">
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slasd5.f">
*> [TXT]</a>
*> \endhtmlonly
*
*  Definition:
*  ===========
*
*       SUBROUTINE SLASD5( I, D, Z, DELTA, RHO, DSIGMA, WORK )
*
*       .. Scalar Arguments ..
*       INTEGER            I
*       REAL               DSIGMA, RHO
*       ..
*       .. Array Arguments ..
*       REAL               D( 2 ), DELTA( 2 ), WORK( 2 ), Z( 2 )
*       ..
*
*
*> \par Purpose:
*  =============
*>
*> \verbatim
*>
*> This subroutine computes the square root of the I-th eigenvalue
*> of a positive symmetric rank-one modification of a 2-by-2 diagonal
*> matrix
*>
*>            diag( D ) * diag( D ) +  RHO * Z * transpose(Z) .
*>
*> The diagonal entries in the array D are assumed to satisfy
*>
*>            0 <= D(i) < D(j)  for  i < j .
*>
*> We also assume RHO > 0 and that the Euclidean norm of the vector
*> Z is one.
*> \endverbatim
*
*  Arguments:
*  ==========
*
*> \param[in] I
*> \verbatim
*>          I is INTEGER
*>         The index of the eigenvalue to be computed.  I = 1 or I = 2.
*> \endverbatim
*>
*> \param[in] D
*> \verbatim
*>          D is REAL array, dimension (2)
*>         The original eigenvalues.  We assume 0 <= D(1) < D(2).
*> \endverbatim
*>
*> \param[in] Z
*> \verbatim
*>          Z is REAL array, dimension (2)
*>         The components of the updating vector.
*> \endverbatim
*>
*> \param[out] DELTA
*> \verbatim
*>          DELTA is REAL array, dimension (2)
*>         Contains (D(j) - sigma_I) in its  j-th component.
*>         The vector DELTA contains the information necessary
*>         to construct the eigenvectors.
*> \endverbatim
*>
*> \param[in] RHO
*> \verbatim
*>          RHO is REAL
*>         The scalar in the symmetric updating formula.
*> \endverbatim
*>
*> \param[out] DSIGMA
*> \verbatim
*>          DSIGMA is REAL
*>         The computed sigma_I, the I-th updated eigenvalue.
*> \endverbatim
*>
*> \param[out] WORK
*> \verbatim
*>          WORK is REAL array, dimension (2)
*>         WORK contains (D(j) + sigma_I) in its  j-th component.
*> \endverbatim
*
*  Authors:
*  ========
*
*> \author Univ. of Tennessee
*> \author Univ. of California Berkeley
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \ingroup lasd5
*
*> \par Contributors:
*  ==================
*>
*>     Ren-Cang Li, Computer Science Division, University of California
*>     at Berkeley, USA
*>
*  =====================================================================
      SUBROUTINE slasd5( I, D, Z, DELTA, RHO, DSIGMA, WORK )
*
*  -- LAPACK auxiliary routine --
*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
*
*     .. Scalar Arguments ..
      INTEGER            I
      REAL               DSIGMA, RHO
*     ..
*     .. Array Arguments ..
      REAL               D( 2 ), DELTA( 2 ), WORK( 2 ), Z( 2 )
*     ..
*
*  =====================================================================
*
*     .. Parameters ..
      REAL               ZERO, ONE, TWO, THREE, FOUR
      parameter( zero = 0.0e+0, one = 1.0e+0, two = 2.0e+0,
     $                   three = 3.0e+0, four = 4.0e+0 )
*     ..
*     .. Local Scalars ..
      REAL               B, C, DEL, DELSQ, TAU, W
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC          abs, sqrt
*     ..
*     .. Executable Statements ..
*
      del = d( 2 ) - d( 1 )
      delsq = del*( d( 2 )+d( 1 ) )
      IF( i.EQ.1 ) THEN
         w = one + four*rho*( z( 2 )*z( 2 ) / ( d( 1 )+three*d( 2 ) )-
     $       z( 1 )*z( 1 ) / ( three*d( 1 )+d( 2 ) ) ) / del
         IF( w.GT.zero ) THEN
            b = delsq + rho*( z( 1 )*z( 1 )+z( 2 )*z( 2 ) )
            c = rho*z( 1 )*z( 1 )*delsq
*
*           B > ZERO, always
*
*           The following TAU is DSIGMA * DSIGMA - D( 1 ) * D( 1 )
*
            tau = two*c / ( b+sqrt( abs( b*b-four*c ) ) )
*
*           The following TAU is DSIGMA - D( 1 )
*
            tau = tau / ( d( 1 )+sqrt( d( 1 )*d( 1 )+tau ) )
            dsigma = d( 1 ) + tau
            delta( 1 ) = -tau
            delta( 2 ) = del - tau
            work( 1 ) = two*d( 1 ) + tau
            work( 2 ) = ( d( 1 )+tau ) + d( 2 )
*           DELTA( 1 ) = -Z( 1 ) / TAU
*           DELTA( 2 ) = Z( 2 ) / ( DEL-TAU )
         ELSE
            b = -delsq + rho*( z( 1 )*z( 1 )+z( 2 )*z( 2 ) )
            c = rho*z( 2 )*z( 2 )*delsq
*
*           The following TAU is DSIGMA * DSIGMA - D( 2 ) * D( 2 )
*
            IF( b.GT.zero ) THEN
               tau = -two*c / ( b+sqrt( b*b+four*c ) )
            ELSE
               tau = ( b-sqrt( b*b+four*c ) ) / two
            END IF
*
*           The following TAU is DSIGMA - D( 2 )
*
            tau = tau / ( d( 2 )+sqrt( abs( d( 2 )*d( 2 )+tau ) ) )
            dsigma = d( 2 ) + tau
            delta( 1 ) = -( del+tau )
            delta( 2 ) = -tau
            work( 1 ) = d( 1 ) + tau + d( 2 )
            work( 2 ) = two*d( 2 ) + tau
*           DELTA( 1 ) = -Z( 1 ) / ( DEL+TAU )
*           DELTA( 2 ) = -Z( 2 ) / TAU
         END IF
*        TEMP = SQRT( DELTA( 1 )*DELTA( 1 )+DELTA( 2 )*DELTA( 2 ) )
*        DELTA( 1 ) = DELTA( 1 ) / TEMP
*        DELTA( 2 ) = DELTA( 2 ) / TEMP
      ELSE
*
*        Now I=2
*
         b = -delsq + rho*( z( 1 )*z( 1 )+z( 2 )*z( 2 ) )
         c = rho*z( 2 )*z( 2 )*delsq
*
*        The following TAU is DSIGMA * DSIGMA - D( 2 ) * D( 2 )
*
         IF( b.GT.zero ) THEN
            tau = ( b+sqrt( b*b+four*c ) ) / two
         ELSE
            tau = two*c / ( -b+sqrt( b*b+four*c ) )
         END IF
*
*        The following TAU is DSIGMA - D( 2 )
*
         tau = tau / ( d( 2 )+sqrt( d( 2 )*d( 2 )+tau ) )
         dsigma = d( 2 ) + tau
         delta( 1 ) = -( del+tau )
         delta( 2 ) = -tau
         work( 1 ) = d( 1 ) + tau + d( 2 )
         work( 2 ) = two*d( 2 ) + tau
*        DELTA( 1 ) = -Z( 1 ) / ( DEL+TAU )
*        DELTA( 2 ) = -Z( 2 ) / TAU
*        TEMP = SQRT( DELTA( 1 )*DELTA( 1 )+DELTA( 2 )*DELTA( 2 ) )
*        DELTA( 1 ) = DELTA( 1 ) / TEMP
*        DELTA( 2 ) = DELTA( 2 ) / TEMP
      END IF
      RETURN
*
*     End of SLASD5
*
      END