LAPACK  3.10.0
LAPACK: Linear Algebra PACKage

◆ 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.

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

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

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: