LAPACK  3.8.0
LAPACK: Linear Algebra PACKage
slartgs.f
Go to the documentation of this file.
1 *> \brief \b SLARTGS generates a plane rotation designed to introduce a bulge in implicit QR iteration for the bidiagonal SVD problem.
2 *
3 * =========== DOCUMENTATION ===========
4 *
5 * Online html documentation available at
6 * http://www.netlib.org/lapack/explore-html/
7 *
8 *> \htmlonly
9 *> Download SLARTGS + dependencies
10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slartgs.f">
11 *> [TGZ]</a>
12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slartgs.f">
13 *> [ZIP]</a>
14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slartgs.f">
15 *> [TXT]</a>
16 *> \endhtmlonly
17 *
18 * Definition:
19 * ===========
20 *
21 * SUBROUTINE SLARTGS( X, Y, SIGMA, CS, SN )
22 *
23 * .. Scalar Arguments ..
24 * REAL CS, SIGMA, SN, X, Y
25 * ..
26 *
27 *
28 *> \par Purpose:
29 * =============
30 *>
31 *> \verbatim
32 *>
33 *> SLARTGS generates a plane rotation designed to introduce a bulge in
34 *> Golub-Reinsch-style implicit QR iteration for the bidiagonal SVD
35 *> problem. X and Y are the top-row entries, and SIGMA is the shift.
36 *> The computed CS and SN define a plane rotation satisfying
37 *>
38 *> [ CS SN ] . [ X^2 - SIGMA ] = [ R ],
39 *> [ -SN CS ] [ X * Y ] [ 0 ]
40 *>
41 *> with R nonnegative. If X^2 - SIGMA and X * Y are 0, then the
42 *> rotation is by PI/2.
43 *> \endverbatim
44 *
45 * Arguments:
46 * ==========
47 *
48 *> \param[in] X
49 *> \verbatim
50 *> X is REAL
51 *> The (1,1) entry of an upper bidiagonal matrix.
52 *> \endverbatim
53 *>
54 *> \param[in] Y
55 *> \verbatim
56 *> Y is REAL
57 *> The (1,2) entry of an upper bidiagonal matrix.
58 *> \endverbatim
59 *>
60 *> \param[in] SIGMA
61 *> \verbatim
62 *> SIGMA is REAL
63 *> The shift.
64 *> \endverbatim
65 *>
66 *> \param[out] CS
67 *> \verbatim
68 *> CS is REAL
69 *> The cosine of the rotation.
70 *> \endverbatim
71 *>
72 *> \param[out] SN
73 *> \verbatim
74 *> SN is REAL
75 *> The sine of the rotation.
76 *> \endverbatim
77 *
78 * Authors:
79 * ========
80 *
81 *> \author Univ. of Tennessee
82 *> \author Univ. of California Berkeley
83 *> \author Univ. of Colorado Denver
84 *> \author NAG Ltd.
85 *
86 *> \date November 2017
87 *
88 *> \ingroup auxOTHERcomputational
89 *
90 * =====================================================================
91  SUBROUTINE slartgs( X, Y, SIGMA, CS, SN )
92 *
93 * -- LAPACK computational routine (version 3.8.0) --
94 * -- LAPACK is a software package provided by Univ. of Tennessee, --
95 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
96 * November 2017
97 *
98 * .. Scalar Arguments ..
99  REAL CS, SIGMA, SN, X, Y
100 * ..
101 *
102 * ===================================================================
103 *
104 * .. Parameters ..
105  REAL NEGONE, ONE, ZERO
106  parameter( negone = -1.0e0, one = 1.0e0, zero = 0.0e0 )
107 * ..
108 * .. Local Scalars ..
109  REAL R, S, THRESH, W, Z
110 * ..
111 * .. External Subroutines ..
112  EXTERNAL slartgp
113 * ..
114 * .. External Functions ..
115  REAL SLAMCH
116  EXTERNAL slamch
117 * .. Executable Statements ..
118 *
119  thresh = slamch('E')
120 *
121 * Compute the first column of B**T*B - SIGMA^2*I, up to a scale
122 * factor.
123 *
124  IF( (sigma .EQ. zero .AND. abs(x) .LT. thresh) .OR.
125  $ (abs(x) .EQ. sigma .AND. y .EQ. zero) ) THEN
126  z = zero
127  w = zero
128  ELSE IF( sigma .EQ. zero ) THEN
129  IF( x .GE. zero ) THEN
130  z = x
131  w = y
132  ELSE
133  z = -x
134  w = -y
135  END IF
136  ELSE IF( abs(x) .LT. thresh ) THEN
137  z = -sigma*sigma
138  w = zero
139  ELSE
140  IF( x .GE. zero ) THEN
141  s = one
142  ELSE
143  s = negone
144  END IF
145  z = s * (abs(x)-sigma) * (s+sigma/x)
146  w = s * y
147  END IF
148 *
149 * Generate the rotation.
150 * CALL SLARTGP( Z, W, CS, SN, R ) might seem more natural;
151 * reordering the arguments ensures that if Z = 0 then the rotation
152 * is by PI/2.
153 *
154  CALL slartgp( w, z, sn, cs, r )
155 *
156  RETURN
157 *
158 * End SLARTGS
159 *
160  END
161 
subroutine slartgp(F, G, CS, SN, R)
SLARTGP generates a plane rotation so that the diagonal is nonnegative.
Definition: slartgp.f:97
subroutine slartgs(X, Y, SIGMA, CS, SN)
SLARTGS generates a plane rotation designed to introduce a bulge in implicit QR iteration for the bid...
Definition: slartgs.f:92