LAPACK  3.8.0
LAPACK: Linear Algebra PACKage

◆ slartg()

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

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

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

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.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
December 2016

Definition at line 99 of file slartg.f.

99 *
100 * -- LAPACK auxiliary routine (version 3.7.0) --
101 * -- LAPACK is a software package provided by Univ. of Tennessee, --
102 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
103 * December 2016
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: