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.

*
*  -- LAPACK auxiliary routine (version 3.4.2) --
*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
*     September 2012
*
*     .. Scalar Arguments ..
      DOUBLE PRECISION   cs, f, g, r, sn
*     ..
*
*  =====================================================================
*
*     .. Parameters ..
      DOUBLE PRECISION   zero
      parameter                ( zero = 0.0d0 )
      DOUBLE PRECISION   one
      parameter                ( one = 1.0d0 )
      DOUBLE PRECISION   two
      parameter                ( two = 2.0d0 )
*     ..
*     .. Local Scalars ..
*     LOGICAL            FIRST
      INTEGER            count, i
      DOUBLE PRECISION   eps, f1, g1, safmin, safmn2, safmx2, scale
*     ..
*     .. External Functions ..
      DOUBLE PRECISION   dlamch
      EXTERNAL           dlamch
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC          abs, int, log, max, sqrt
*     ..
*     .. Save statement ..
*     SAVE               FIRST, SAFMX2, SAFMIN, SAFMN2
*     ..
*     .. Data statements ..
*     DATA               FIRST / .TRUE. /
*     ..
*     .. Executable Statements ..
*
*     IF( FIRST ) THEN
         safmin = dlamch( 'S' )
         eps = dlamch( 'E' )
         safmn2 = dlamch( 'B' )**int( log( safmin / eps ) /
     $            log( dlamch( 'B' ) ) / two )
         safmx2 = one / safmn2
*        FIRST = .FALSE.
*     END IF
      IF( g.EQ.zero ) THEN
         cs = one
         sn = zero
         r = f
      ELSE IF( f.EQ.zero ) THEN
         cs = zero
         sn = one
         r = g
      ELSE
         f1 = f
         g1 = g
         scale = max( abs( f1 ), abs( g1 ) )
         IF( scale.GE.safmx2 ) THEN
            count = 0
   10       CONTINUE
            count = count + 1
            f1 = f1*safmn2
            g1 = g1*safmn2
            scale = max( abs( f1 ), abs( g1 ) )
            IF( scale.GE.safmx2 )
     $         GO TO 10
            r = sqrt( f1**2+g1**2 )
            cs = f1 / r
            sn = g1 / r
            DO 20 i = 1, count
               r = r*safmx2
   20       CONTINUE
         ELSE IF( scale.LE.safmn2 ) THEN
            count = 0
   30       CONTINUE
            count = count + 1
            f1 = f1*safmx2
            g1 = g1*safmx2
            scale = max( abs( f1 ), abs( g1 ) )
            IF( scale.LE.safmn2 )
     $         GO TO 30
            r = sqrt( f1**2+g1**2 )
            cs = f1 / r
            sn = g1 / r
            DO 40 i = 1, count
               r = r*safmn2
   40       CONTINUE
         ELSE
            r = sqrt( f1**2+g1**2 )
            cs = f1 / r
            sn = g1 / r
         END IF
         IF( abs( f ).GT.abs( g ) .AND. cs.LT.zero ) THEN
            cs = -cs
            sn = -sn
            r = -r
         END IF
      END IF
      RETURN
*
*     End of DLARTG
*

Here is the caller graph for this function: