crotg.f (cxxblas/netlib/blas/crotg.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

      SUBROUTINE CROTG(CA,CB,C,S)

*     .. Scalar Arguments ..

      COMPLEX CA,CB,S

      REAL C

*     ..

*

*  Purpose

*  =======

*

*  CROTG determines a complex Givens rotation.

*

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

*

*     .. Local Scalars ..

      COMPLEX ALPHA

      REAL NORM,SCALE

*     ..

*     .. Intrinsic Functions ..

      INTRINSIC CABS,CONJG,SQRT

*     ..

      IF (CABS(CA).EQ.0.) THEN

         C = 0.

         S = (1.,0.)

         CA = CB

      ELSE

         SCALE = CABS(CA) + CABS(CB)

         NORM = SCALE*SQRT((CABS(CA/SCALE))**2+ (CABS(CB/SCALE))**2)

         ALPHA = CA/CABS(CA)

         C = CABS(CA)/NORM

         S = ALPHA*CONJG(CB)/NORM

         CA = ALPHA*NORM

      END IF

      RETURN

      END