LAPACK  3.10.1 LAPACK: Linear Algebra PACKage

## ◆ slartgp()

 subroutine slartgp ( real F, real G, real CS, real SN, real R )

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

Download SLARTGP + dependencies [TGZ] [ZIP] [TXT]

Purpose:
``` SLARTGP 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 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.

The sign is chosen so that R >= 0.```
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.```

Definition at line 94 of file slartgp.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  REAL CS, F, G, R, SN
102 * ..
103 *
104 * =====================================================================
105 *
106 * .. Parameters ..
107  REAL ZERO
108  parameter( zero = 0.0e0 )
109  REAL ONE
110  parameter( one = 1.0e0 )
111  REAL TWO
112  parameter( two = 2.0e0 )
113 * ..
114 * .. Local Scalars ..
115 * LOGICAL FIRST
116  INTEGER COUNT, I
117  REAL EPS, F1, G1, SAFMIN, SAFMN2, SAFMX2, SCALE
118 * ..
119 * .. External Functions ..
120  REAL SLAMCH
121  EXTERNAL slamch
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 = slamch( 'S' )
136  eps = slamch( 'E' )
137  safmn2 = slamch( 'B' )**int( log( safmin / eps ) /
138  \$ log( slamch( '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 SLARTGP
198 *
real function slamch(CMACH)
SLAMCH
Definition: slamch.f:68
Here is the caller graph for this function: