LAPACK 3.11.0 LAPACK: Linear Algebra PACKage
Searching...
No Matches
dlartgp.f
Go to the documentation of this file.
1*> \brief \b DLARTGP generates a plane rotation so that the diagonal is nonnegative.
2*
3* =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6* http://www.netlib.org/lapack/explore-html/
7*
8*> \htmlonly
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlartgp.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlartgp.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlartgp.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18* Definition:
19* ===========
20*
21* SUBROUTINE DLARTGP( F, G, CS, SN, R )
22*
23* .. Scalar Arguments ..
24* DOUBLE PRECISION CS, F, G, R, SN
25* ..
26*
27*
28*> \par Purpose:
29* =============
30*>
31*> \verbatim
32*>
33*> DLARTGP generates a plane rotation so that
34*>
35*> [ CS SN ] . [ F ] = [ R ] where CS**2 + SN**2 = 1.
36*> [ -SN CS ] [ G ] [ 0 ]
37*>
38*> This is a slower, more accurate version of the Level 1 BLAS routine DROTG,
39*> with the following other differences:
40*> F and G are unchanged on return.
41*> If G=0, then CS=(+/-)1 and SN=0.
42*> If F=0 and (G .ne. 0), then CS=0 and SN=(+/-)1.
43*>
44*> The sign is chosen so that R >= 0.
45*> \endverbatim
46*
47* Arguments:
48* ==========
49*
50*> \param[in] F
51*> \verbatim
52*> F is DOUBLE PRECISION
53*> The first component of vector to be rotated.
54*> \endverbatim
55*>
56*> \param[in] G
57*> \verbatim
58*> G is DOUBLE PRECISION
59*> The second component of vector to be rotated.
60*> \endverbatim
61*>
62*> \param[out] CS
63*> \verbatim
64*> CS is DOUBLE PRECISION
65*> The cosine of the rotation.
66*> \endverbatim
67*>
68*> \param[out] SN
69*> \verbatim
70*> SN is DOUBLE PRECISION
71*> The sine of the rotation.
72*> \endverbatim
73*>
74*> \param[out] R
75*> \verbatim
76*> R is DOUBLE PRECISION
77*> The nonzero component of the rotated vector.
78*>
79*> This version has a few statements commented out for thread safety
80*> (machine parameters are computed on each entry). 10 feb 03, SJH.
81*> \endverbatim
82*
83* Authors:
84* ========
85*
86*> \author Univ. of Tennessee
87*> \author Univ. of California Berkeley
88*> \author Univ. of Colorado Denver
89*> \author NAG Ltd.
90*
91*> \ingroup OTHERauxiliary
92*
93* =====================================================================
94 SUBROUTINE dlartgp( F, G, CS, SN, R )
95*
96* -- LAPACK auxiliary routine --
97* -- LAPACK is a software package provided by Univ. of Tennessee, --
98* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
99*
100* .. Scalar Arguments ..
101 DOUBLE PRECISION CS, F, G, R, SN
102* ..
103*
104* =====================================================================
105*
106* .. Parameters ..
107 DOUBLE PRECISION ZERO
108 parameter( zero = 0.0d0 )
109 DOUBLE PRECISION ONE
110 parameter( one = 1.0d0 )
111 DOUBLE PRECISION TWO
112 parameter( two = 2.0d0 )
113* ..
114* .. Local Scalars ..
115* LOGICAL FIRST
116 INTEGER COUNT, I
117 DOUBLE PRECISION EPS, F1, G1, SAFMIN, SAFMN2, SAFMX2, SCALE
118* ..
119* .. External Functions ..
120 DOUBLE PRECISION DLAMCH
121 EXTERNAL dlamch
122* ..
123* .. Intrinsic Functions ..
124 INTRINSIC abs, int, log, max, sign, sqrt
125* ..
126* .. Save statement ..
127* SAVE FIRST, SAFMX2, SAFMIN, SAFMN2
128* ..
129* .. Data statements ..
130* DATA FIRST / .TRUE. /
131* ..
132* .. Executable Statements ..
133*
134* IF( FIRST ) THEN
135 safmin = dlamch( 'S' )
136 eps = dlamch( 'E' )
137 safmn2 = dlamch( 'B' )**int( log( safmin / eps ) /
138 \$ log( dlamch( 'B' ) ) / two )
139 safmx2 = one / safmn2
140* FIRST = .FALSE.
141* END IF
142 IF( g.EQ.zero ) THEN
143 cs = sign( one, f )
144 sn = zero
145 r = abs( f )
146 ELSE IF( f.EQ.zero ) THEN
147 cs = zero
148 sn = sign( one, g )
149 r = abs( g )
150 ELSE
151 f1 = f
152 g1 = g
153 scale = max( abs( f1 ), abs( g1 ) )
154 IF( scale.GE.safmx2 ) THEN
155 count = 0
156 10 CONTINUE
157 count = count + 1
158 f1 = f1*safmn2
159 g1 = g1*safmn2
160 scale = max( abs( f1 ), abs( g1 ) )
161 IF( scale.GE.safmx2 .AND. count .LT. 20 )
162 \$ GO TO 10
163 r = sqrt( f1**2+g1**2 )
164 cs = f1 / r
165 sn = g1 / r
166 DO 20 i = 1, count
167 r = r*safmx2
168 20 CONTINUE
169 ELSE IF( scale.LE.safmn2 ) THEN
170 count = 0
171 30 CONTINUE
172 count = count + 1
173 f1 = f1*safmx2
174 g1 = g1*safmx2
175 scale = max( abs( f1 ), abs( g1 ) )
176 IF( scale.LE.safmn2 )
177 \$ GO TO 30
178 r = sqrt( f1**2+g1**2 )
179 cs = f1 / r
180 sn = g1 / r
181 DO 40 i = 1, count
182 r = r*safmn2
183 40 CONTINUE
184 ELSE
185 r = sqrt( f1**2+g1**2 )
186 cs = f1 / r
187 sn = g1 / r
188 END IF
189 IF( r.LT.zero ) THEN
190 cs = -cs
191 sn = -sn
192 r = -r
193 END IF
194 END IF
195 RETURN
196*
197* End of DLARTGP
198*
199 END
subroutine dlartgp(F, G, CS, SN, R)
DLARTGP generates a plane rotation so that the diagonal is nonnegative.
Definition: dlartgp.f:95