LAPACK 3.12.0 LAPACK: Linear Algebra PACKage
Searching...
No Matches

## ◆ dlartgp()

 subroutine dlartgp ( double precision f, double precision g, double precision cs, double precision sn, double precision r )

DLARTGP generates a plane rotation so that the diagonal is nonnegative.

Purpose:
``` DLARTGP generates a plane rotation so that

[  CS  SN  ]  .  [ F ]  =  [ R ]   where CS**2 + SN**2 = 1.
[ -SN  CS  ]     [ G ]     [ 0 ]

This is a slower, more accurate version of the Level 1 BLAS routine DROTG,
with the following other differences:
F and G are unchanged on return.
If G=0, then CS=(+/-)1 and SN=0.
If F=0 and (G .ne. 0), then CS=0 and SN=(+/-)1.

The sign is chosen so that R >= 0.```
Parameters
 [in] F ``` F is DOUBLE PRECISION The first component of vector to be rotated.``` [in] G ``` G is DOUBLE PRECISION The second component of vector to be rotated.``` [out] CS ``` CS is DOUBLE PRECISION The cosine of the rotation.``` [out] SN ``` SN is DOUBLE PRECISION The sine of the rotation.``` [out] R ``` R is DOUBLE PRECISION The nonzero component of the rotated vector. This version has a few statements commented out for thread safety (machine parameters are computed on each entry). 10 feb 03, SJH.```

Definition at line 94 of file dlartgp.f.

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*
double precision function dlamch(cmach)
DLAMCH
Definition dlamch.f:69
Here is the caller graph for this function: