LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
subroutine dlartg ( double precision  F,
double precision  G,
double precision  CS,
double precision  SN,
double precision  R 
)

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

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

Purpose:
 DLARTG 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 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 without doing any
       floating point operations (saves work in DBDSQR when
       there are zeros on the diagonal).

 If F exceeds G in magnitude, CS will be positive.
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.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
September 2012

Definition at line 99 of file dlartg.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  DOUBLE PRECISION cs, f, g, r, sn
107 * ..
108 *
109 * =====================================================================
110 *
111 * .. Parameters ..
112  DOUBLE PRECISION zero
113  parameter ( zero = 0.0d0 )
114  DOUBLE PRECISION one
115  parameter ( one = 1.0d0 )
116  DOUBLE PRECISION two
117  parameter ( two = 2.0d0 )
118 * ..
119 * .. Local Scalars ..
120 * LOGICAL FIRST
121  INTEGER count, i
122  DOUBLE PRECISION eps, f1, g1, safmin, safmn2, safmx2, scale
123 * ..
124 * .. External Functions ..
125  DOUBLE PRECISION dlamch
126  EXTERNAL dlamch
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 = dlamch( 'S' )
141  eps = dlamch( 'E' )
142  safmn2 = dlamch( 'B' )**int( log( safmin / eps ) /
143  $ log( dlamch( '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 DLARTG
203 *
double precision function dlamch(CMACH)
DLAMCH
Definition: dlamch.f:65

Here is the caller graph for this function: