drotg.f (cxxblas/netlib/blas/drotg.f)

      1
      2
      3
      4
      5
      6
      7
      8
      9
     10
     11
     12
     13
     14
     15
     16
     17
     18
     19
     20
     21
     22
     23
     24
     25
     26
     27
     28
     29
     30
     31
     32
     33
     34
     35
     36
     37
     38
     39
     40
     41
     42
     43
     44

      SUBROUTINE DROTG(DA,DB,C,S)

*     .. Scalar Arguments ..

      DOUBLE PRECISION C,DA,DB,S

*     ..

*

*  Purpose

*  =======

*

*     DROTG construct givens plane rotation.

*

*  Further Details

*  ===============

*

*     jack dongarra, linpack, 3/11/78.

*

*  =====================================================================

*

*     .. Local Scalars ..

      DOUBLE PRECISION R,ROE,SCALE,Z

*     ..

*     .. Intrinsic Functions ..

      INTRINSIC DABS,DSIGN,DSQRT

*     ..

      ROE = DB

      IF (DABS(DA).GT.DABS(DB)) ROE = DA

      SCALE = DABS(DA) + DABS(DB)

      IF (SCALE.EQ.0.0d0) THEN

         C = 1.0d0

         S = 0.0d0

         R = 0.0d0

         Z = 0.0d0

      ELSE

         R = SCALE*DSQRT((DA/SCALE)**2+ (DB/SCALE)**2)

         R = DSIGN(1.0d0,ROE)*R

         C = DA/R

         S = DB/R

         Z = 1.0d0

         IF (DABS(DA).GT.DABS(DB)) Z = S

         IF (DABS(DB).GE.DABS(DA) .AND. C.NE.0.0d0) Z = 1.0d0/C

      END IF

      DA = R

      DB = Z

      RETURN

      END