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 92 of file dlartgp.f.

*
*  -- LAPACK auxiliary routine --
*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
*
*     .. 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, sign, 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 = sign( one, f )
         sn = zero
         r = abs( f )
      ELSE IF( f.EQ.zero ) THEN
         cs = zero
         sn = sign( one, g )
         r = abs( 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 .AND. count .LT. 20 )
     $         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( r.LT.zero ) THEN
            cs = -cs
            sn = -sn
            r = -r
         END IF
      END IF
      RETURN
*
*     End of DLARTGP
*

Here is the caller graph for this function: