![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b SLARTGS 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 *> \htmlonly 00009 *> Download SLARTGS + dependencies 00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slartgs.f"> 00011 *> [TGZ]</a> 00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slartgs.f"> 00013 *> [ZIP]</a> 00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slartgs.f"> 00015 *> [TXT]</a> 00016 *> \endhtmlonly 00017 * 00018 * Definition: 00019 * =========== 00020 * 00021 * SUBROUTINE SLARTGS( X, Y, SIGMA, CS, SN ) 00022 * 00023 * .. Scalar Arguments .. 00024 * REAL CS, SIGMA, SN, X, Y 00025 * .. 00026 * 00027 * 00028 *> \par Purpose: 00029 * ============= 00030 *> 00031 *> \verbatim 00032 *> 00033 *> SLARTGS 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 REAL 00051 *> The (1,1) entry of an upper bidiagonal matrix. 00052 *> \endverbatim 00053 *> 00054 *> \param[in] Y 00055 *> \verbatim 00056 *> Y is REAL 00057 *> The (1,2) entry of an upper bidiagonal matrix. 00058 *> \endverbatim 00059 *> 00060 *> \param[in] SIGMA 00061 *> \verbatim 00062 *> SIGMA is REAL 00063 *> The shift. 00064 *> \endverbatim 00065 *> 00066 *> \param[out] CS 00067 *> \verbatim 00068 *> CS is REAL 00069 *> The cosine of the rotation. 00070 *> \endverbatim 00071 *> 00072 *> \param[out] SN 00073 *> \verbatim 00074 *> SN is REAL 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 SLARTGS( 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 REAL CS, SIGMA, SN, X, Y 00100 * .. 00101 * 00102 * =================================================================== 00103 * 00104 * .. Parameters .. 00105 REAL NEGONE, ONE, ZERO 00106 PARAMETER ( NEGONE = -1.0E0, ONE = 1.0E0, ZERO = 0.0E0 ) 00107 * .. 00108 * .. Local Scalars .. 00109 REAL R, S, THRESH, W, Z 00110 * .. 00111 * .. External Functions .. 00112 REAL SLAMCH 00113 EXTERNAL SLAMCH 00114 * .. Executable Statements .. 00115 * 00116 THRESH = SLAMCH('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 SLARTGP( 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 SLARTGP( W, Z, SN, CS, R ) 00152 * 00153 RETURN 00154 * 00155 * End SLARTGS 00156 * 00157 END 00158