LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
dlartgs.f
Go to the documentation of this file.
00001 *> \brief \b DLARTGS
00002 *
00003 *  =========== DOCUMENTATION ===========
00004 *
00005 * Online html documentation available at 
00006 *            http://www.netlib.org/lapack/explore-html/ 
00007 *
00008 *> \htmlonly
00009 *> Download DLARTGS + dependencies 
00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlartgs.f"> 
00011 *> [TGZ]</a> 
00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlartgs.f"> 
00013 *> [ZIP]</a> 
00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlartgs.f"> 
00015 *> [TXT]</a>
00016 *> \endhtmlonly 
00017 *
00018 *  Definition:
00019 *  ===========
00020 *
00021 *       SUBROUTINE DLARTGS( X, Y, SIGMA, CS, SN )
00022 * 
00023 *       .. Scalar Arguments ..
00024 *       DOUBLE PRECISION        CS, SIGMA, SN, X, Y
00025 *       ..
00026 *  
00027 *
00028 *> \par Purpose:
00029 *  =============
00030 *>
00031 *> \verbatim
00032 *>
00033 *> DLARTGS generates a plane rotation designed to introduce a bulge in
00034 *> Golub-Reinsch-style implicit QR iteration for the bidiagonal SVD
00035 *> problem. X and Y are the top-row entries, and SIGMA is the shift.
00036 *> The computed CS and SN define a plane rotation satisfying
00037 *>
00038 *>    [  CS  SN  ]  .  [ X^2 - SIGMA ]  =  [ R ],
00039 *>    [ -SN  CS  ]     [    X * Y    ]     [ 0 ]
00040 *>
00041 *> with R nonnegative.  If X^2 - SIGMA and X * Y are 0, then the
00042 *> rotation is by PI/2.
00043 *> \endverbatim
00044 *
00045 *  Arguments:
00046 *  ==========
00047 *
00048 *> \param[in] X
00049 *> \verbatim
00050 *>          X is DOUBLE PRECISION
00051 *>          The (1,1) entry of an upper bidiagonal matrix.
00052 *> \endverbatim
00053 *>
00054 *> \param[in] Y
00055 *> \verbatim
00056 *>          Y is DOUBLE PRECISION
00057 *>          The (1,2) entry of an upper bidiagonal matrix.
00058 *> \endverbatim
00059 *>
00060 *> \param[in] SIGMA
00061 *> \verbatim
00062 *>          SIGMA is DOUBLE PRECISION
00063 *>          The shift.
00064 *> \endverbatim
00065 *>
00066 *> \param[out] CS
00067 *> \verbatim
00068 *>          CS is DOUBLE PRECISION
00069 *>          The cosine of the rotation.
00070 *> \endverbatim
00071 *>
00072 *> \param[out] SN
00073 *> \verbatim
00074 *>          SN is DOUBLE PRECISION
00075 *>          The sine of the rotation.
00076 *> \endverbatim
00077 *
00078 *  Authors:
00079 *  ========
00080 *
00081 *> \author Univ. of Tennessee 
00082 *> \author Univ. of California Berkeley 
00083 *> \author Univ. of Colorado Denver 
00084 *> \author NAG Ltd. 
00085 *
00086 *> \date November 2011
00087 *
00088 *> \ingroup auxOTHERcomputational
00089 *
00090 *  =====================================================================
00091       SUBROUTINE DLARTGS( X, Y, SIGMA, CS, SN )
00092 *
00093 *  -- LAPACK computational routine (version 3.4.0) --
00094 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00095 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00096 *     November 2011
00097 *
00098 *     .. Scalar Arguments ..
00099       DOUBLE PRECISION        CS, SIGMA, SN, X, Y
00100 *     ..
00101 *
00102 *  ===================================================================
00103 *
00104 *     .. Parameters ..
00105       DOUBLE PRECISION        NEGONE, ONE, ZERO
00106       PARAMETER          ( NEGONE = -1.0D0, ONE = 1.0D0, ZERO = 0.0D0 )
00107 *     ..
00108 *     .. Local Scalars ..
00109       DOUBLE PRECISION        R, S, THRESH, W, Z
00110 *     ..
00111 *     .. External Functions ..
00112       DOUBLE PRECISION        DLAMCH
00113       EXTERNAL           DLAMCH
00114 *     .. Executable Statements ..
00115 *
00116       THRESH = DLAMCH('E')
00117 *
00118 *     Compute the first column of B**T*B - SIGMA^2*I, up to a scale
00119 *     factor.
00120 *
00121       IF( (SIGMA .EQ. ZERO .AND. ABS(X) .LT. THRESH) .OR.
00122      $          (ABS(X) .EQ. SIGMA .AND. Y .EQ. ZERO) ) THEN
00123          Z = ZERO
00124          W = ZERO
00125       ELSE IF( SIGMA .EQ. ZERO ) THEN
00126          IF( X .GE. ZERO ) THEN
00127             Z = X
00128             W = Y
00129          ELSE
00130             Z = -X
00131             W = -Y
00132          END IF
00133       ELSE IF( ABS(X) .LT. THRESH ) THEN
00134          Z = -SIGMA*SIGMA
00135          W = ZERO
00136       ELSE
00137          IF( X .GE. ZERO ) THEN
00138             S = ONE
00139          ELSE
00140             S = NEGONE
00141          END IF
00142          Z = S * (ABS(X)-SIGMA) * (S+SIGMA/X)
00143          W = S * Y
00144       END IF
00145 *
00146 *     Generate the rotation.
00147 *     CALL DLARTGP( Z, W, CS, SN, R ) might seem more natural;
00148 *     reordering the arguments ensures that if Z = 0 then the rotation
00149 *     is by PI/2.
00150 *
00151       CALL DLARTGP( W, Z, SN, CS, R )
00152 *
00153       RETURN
00154 *
00155 *     End DLARTGS
00156 *
00157       END
00158 
 All Files Functions