Annotation of rpl/lapack/lapack/dlartgs.f, revision 1.14
1.7 bertrand 1: *> \brief \b DLARTGS generates a plane rotation designed to introduce a bulge in implicit QR iteration for the bidiagonal SVD problem.
1.4 bertrand 2: *
3: * =========== DOCUMENTATION ===========
4: *
1.11 bertrand 5: * Online html documentation available at
6: * http://www.netlib.org/lapack/explore-html/
1.4 bertrand 7: *
8: *> \htmlonly
1.11 bertrand 9: *> Download DLARTGS + dependencies
10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlartgs.f">
11: *> [TGZ]</a>
12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlartgs.f">
13: *> [ZIP]</a>
14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlartgs.f">
1.4 bertrand 15: *> [TXT]</a>
1.11 bertrand 16: *> \endhtmlonly
1.4 bertrand 17: *
18: * Definition:
19: * ===========
20: *
21: * SUBROUTINE DLARTGS( X, Y, SIGMA, CS, SN )
1.11 bertrand 22: *
1.4 bertrand 23: * .. Scalar Arguments ..
24: * DOUBLE PRECISION CS, SIGMA, SN, X, Y
25: * ..
1.11 bertrand 26: *
1.4 bertrand 27: *
28: *> \par Purpose:
29: * =============
30: *>
31: *> \verbatim
32: *>
33: *> DLARTGS 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 DOUBLE PRECISION
51: *> The (1,1) entry of an upper bidiagonal matrix.
52: *> \endverbatim
53: *>
54: *> \param[in] Y
55: *> \verbatim
56: *> Y is DOUBLE PRECISION
57: *> The (1,2) entry of an upper bidiagonal matrix.
58: *> \endverbatim
59: *>
60: *> \param[in] SIGMA
61: *> \verbatim
62: *> SIGMA is DOUBLE PRECISION
63: *> The shift.
64: *> \endverbatim
65: *>
66: *> \param[out] CS
67: *> \verbatim
68: *> CS is DOUBLE PRECISION
69: *> The cosine of the rotation.
70: *> \endverbatim
71: *>
72: *> \param[out] SN
73: *> \verbatim
74: *> SN is DOUBLE PRECISION
75: *> The sine of the rotation.
76: *> \endverbatim
77: *
78: * Authors:
79: * ========
80: *
1.11 bertrand 81: *> \author Univ. of Tennessee
82: *> \author Univ. of California Berkeley
83: *> \author Univ. of Colorado Denver
84: *> \author NAG Ltd.
1.4 bertrand 85: *
1.13 bertrand 86: *> \date November 2017
1.1 bertrand 87: *
1.4 bertrand 88: *> \ingroup auxOTHERcomputational
1.1 bertrand 89: *
1.4 bertrand 90: * =====================================================================
91: SUBROUTINE DLARTGS( X, Y, SIGMA, CS, SN )
1.1 bertrand 92: *
1.13 bertrand 93: * -- LAPACK computational routine (version 3.8.0) --
1.1 bertrand 94: * -- LAPACK is a software package provided by Univ. of Tennessee, --
1.4 bertrand 95: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
1.13 bertrand 96: * November 2017
1.1 bertrand 97: *
98: * .. Scalar Arguments ..
99: DOUBLE PRECISION CS, SIGMA, SN, X, Y
100: * ..
101: *
102: * ===================================================================
103: *
104: * .. Parameters ..
105: DOUBLE PRECISION NEGONE, ONE, ZERO
106: PARAMETER ( NEGONE = -1.0D0, ONE = 1.0D0, ZERO = 0.0D0 )
107: * ..
108: * .. Local Scalars ..
109: DOUBLE PRECISION R, S, THRESH, W, Z
110: * ..
1.13 bertrand 111: * .. External Subroutines ..
112: EXTERNAL DLARTGP
113: * ..
1.1 bertrand 114: * .. External Functions ..
115: DOUBLE PRECISION DLAMCH
116: EXTERNAL DLAMCH
117: * .. Executable Statements ..
118: *
119: THRESH = DLAMCH('E')
120: *
1.3 bertrand 121: * Compute the first column of B**T*B - SIGMA^2*I, up to a scale
1.1 bertrand 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 DLARTGP( 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 DLARTGP( W, Z, SN, CS, R )
155: *
156: RETURN
157: *
158: * End DLARTGS
159: *
160: END
161:
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to dlartgs.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / lapack / lapack