*> \brief \b SLARTGS * * =========== DOCUMENTATION =========== * * Online html documentation available at * http://www.netlib.org/lapack/explore-html/ * *> \htmlonly *> Download SLARTGS + dependencies *> *> [TGZ] *> *> [ZIP] *> *> [TXT] *> \endhtmlonly * * Definition: * =========== * * SUBROUTINE SLARTGS( X, Y, SIGMA, CS, SN ) * * .. Scalar Arguments .. * REAL CS, SIGMA, SN, X, Y * .. * * *> \par Purpose: * ============= *> *> \verbatim *> *> SLARTGS generates a plane rotation designed to introduce a bulge in *> Golub-Reinsch-style implicit QR iteration for the bidiagonal SVD *> problem. X and Y are the top-row entries, and SIGMA is the shift. *> The computed CS and SN define a plane rotation satisfying *> *> [ CS SN ] . [ X^2 - SIGMA ] = [ R ], *> [ -SN CS ] [ X * Y ] [ 0 ] *> *> with R nonnegative. If X^2 - SIGMA and X * Y are 0, then the *> rotation is by PI/2. *> \endverbatim * * Arguments: * ========== * *> \param[in] X *> \verbatim *> X is REAL *> The (1,1) entry of an upper bidiagonal matrix. *> \endverbatim *> *> \param[in] Y *> \verbatim *> Y is REAL *> The (1,2) entry of an upper bidiagonal matrix. *> \endverbatim *> *> \param[in] SIGMA *> \verbatim *> SIGMA is REAL *> The shift. *> \endverbatim *> *> \param[out] CS *> \verbatim *> CS is REAL *> The cosine of the rotation. *> \endverbatim *> *> \param[out] SN *> \verbatim *> SN is REAL *> The sine of the rotation. *> \endverbatim * * Authors: * ======== * *> \author Univ. of Tennessee *> \author Univ. of California Berkeley *> \author Univ. of Colorado Denver *> \author NAG Ltd. * *> \date November 2011 * *> \ingroup auxOTHERcomputational * * ===================================================================== SUBROUTINE SLARTGS( X, Y, SIGMA, CS, SN ) * * -- LAPACK computational routine (version 3.4.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * November 2011 * * .. Scalar Arguments .. REAL CS, SIGMA, SN, X, Y * .. * * =================================================================== * * .. Parameters .. REAL NEGONE, ONE, ZERO PARAMETER ( NEGONE = -1.0E0, ONE = 1.0E0, ZERO = 0.0E0 ) * .. * .. Local Scalars .. REAL R, S, THRESH, W, Z * .. * .. External Functions .. REAL SLAMCH EXTERNAL SLAMCH * .. Executable Statements .. * THRESH = SLAMCH('E') * * Compute the first column of B**T*B - SIGMA^2*I, up to a scale * factor. * IF( (SIGMA .EQ. ZERO .AND. ABS(X) .LT. THRESH) .OR. $ (ABS(X) .EQ. SIGMA .AND. Y .EQ. ZERO) ) THEN Z = ZERO W = ZERO ELSE IF( SIGMA .EQ. ZERO ) THEN IF( X .GE. ZERO ) THEN Z = X W = Y ELSE Z = -X W = -Y END IF ELSE IF( ABS(X) .LT. THRESH ) THEN Z = -SIGMA*SIGMA W = ZERO ELSE IF( X .GE. ZERO ) THEN S = ONE ELSE S = NEGONE END IF Z = S * (ABS(X)-SIGMA) * (S+SIGMA/X) W = S * Y END IF * * Generate the rotation. * CALL SLARTGP( Z, W, CS, SN, R ) might seem more natural; * reordering the arguments ensures that if Z = 0 then the rotation * is by PI/2. * CALL SLARTGP( W, Z, SN, CS, R ) * RETURN * * End SLARTGS * END