LAPACK  3.6.1 LAPACK: Linear Algebra PACKage
 subroutine slartg ( real F, real G, real CS, real SN, real R )

SLARTG generates a plane rotation with real cosine and real sine.

Purpose:
``` SLARTG generate 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 BLAS1 routine SROTG,
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 without doing any
floating point operations (saves work in SBDSQR when
there are zeros on the diagonal).

If F exceeds G in magnitude, CS will be positive.```
Parameters
 [in] F ``` F is REAL The first component of vector to be rotated.``` [in] G ``` G is REAL The second component of vector to be rotated.``` [out] CS ``` CS is REAL The cosine of the rotation.``` [out] SN ``` SN is REAL The sine of the rotation.``` [out] R ``` R is REAL 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.```
Date
September 2012

Definition at line 99 of file slartg.f.

99 *
100 * -- LAPACK auxiliary routine (version 3.4.2) --
101 * -- LAPACK is a software package provided by Univ. of Tennessee, --
102 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
103 * September 2012
104 *
105 * .. Scalar Arguments ..
106  REAL cs, f, g, r, sn
107 * ..
108 *
109 * =====================================================================
110 *
111 * .. Parameters ..
112  REAL zero
113  parameter ( zero = 0.0e0 )
114  REAL one
115  parameter ( one = 1.0e0 )
116  REAL two
117  parameter ( two = 2.0e0 )
118 * ..
119 * .. Local Scalars ..
120 * LOGICAL FIRST
121  INTEGER count, i
122  REAL eps, f1, g1, safmin, safmn2, safmx2, scale
123 * ..
124 * .. External Functions ..
125  REAL slamch
126  EXTERNAL slamch
127 * ..
128 * .. Intrinsic Functions ..
129  INTRINSIC abs, int, log, max, sqrt
130 * ..
131 * .. Save statement ..
132 * SAVE FIRST, SAFMX2, SAFMIN, SAFMN2
133 * ..
134 * .. Data statements ..
135 * DATA FIRST / .TRUE. /
136 * ..
137 * .. Executable Statements ..
138 *
139 * IF( FIRST ) THEN
140  safmin = slamch( 'S' )
141  eps = slamch( 'E' )
142  safmn2 = slamch( 'B' )**int( log( safmin / eps ) /
143  \$ log( slamch( 'B' ) ) / two )
144  safmx2 = one / safmn2
145 * FIRST = .FALSE.
146 * END IF
147  IF( g.EQ.zero ) THEN
148  cs = one
149  sn = zero
150  r = f
151  ELSE IF( f.EQ.zero ) THEN
152  cs = zero
153  sn = one
154  r = g
155  ELSE
156  f1 = f
157  g1 = g
158  scale = max( abs( f1 ), abs( g1 ) )
159  IF( scale.GE.safmx2 ) THEN
160  count = 0
161  10 CONTINUE
162  count = count + 1
163  f1 = f1*safmn2
164  g1 = g1*safmn2
165  scale = max( abs( f1 ), abs( g1 ) )
166  IF( scale.GE.safmx2 )
167  \$ GO TO 10
168  r = sqrt( f1**2+g1**2 )
169  cs = f1 / r
170  sn = g1 / r
171  DO 20 i = 1, count
172  r = r*safmx2
173  20 CONTINUE
174  ELSE IF( scale.LE.safmn2 ) THEN
175  count = 0
176  30 CONTINUE
177  count = count + 1
178  f1 = f1*safmx2
179  g1 = g1*safmx2
180  scale = max( abs( f1 ), abs( g1 ) )
181  IF( scale.LE.safmn2 )
182  \$ GO TO 30
183  r = sqrt( f1**2+g1**2 )
184  cs = f1 / r
185  sn = g1 / r
186  DO 40 i = 1, count
187  r = r*safmn2
188  40 CONTINUE
189  ELSE
190  r = sqrt( f1**2+g1**2 )
191  cs = f1 / r
192  sn = g1 / r
193  END IF
194  IF( abs( f ).GT.abs( g ) .AND. cs.LT.zero ) THEN
195  cs = -cs
196  sn = -sn
197  r = -r
198  END IF
199  END IF
200  RETURN
201 *
202 * End of SLARTG
203 *
real function slamch(CMACH)
SLAMCH
Definition: slamch.f:69

Here is the caller graph for this function: