LAPACK  3.8.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.
Date
December 2016

Definition at line 97 of file dlartgp.f.

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