BLAS/SRC/zrotg.f

   1 *> \brief \b ZROTG
   2 *
   3 *  =========== DOCUMENTATION ===========
   4 *
   5 * Online html documentation available at
   6 *            http://www.netlib.org/lapack/explore-html/
   7 *
   8 *  Definition:
   9 *  ===========
  10 *
  11 *       SUBROUTINE ZROTG(CA,CB,C,S)
  12 *
  13 *       .. Scalar Arguments ..
  14 *       COMPLEX*16 CA,CB,S
  15 *       DOUBLE PRECISION C
  16 *       ..
  17 *
  18 *
  19 *> \par Purpose:
  20 *  =============
  21 *>
  22 *> \verbatim
  23 *>
  24 *>    ZROTG determines a double complex Givens rotation.
  25 *> \endverbatim
  26 *
  27 *  Authors:
  28 *  ========
  29 *
  30 *> \author Univ. of Tennessee
  31 *> \author Univ. of California Berkeley
  32 *> \author Univ. of Colorado Denver
  33 *> \author NAG Ltd.
  34 *
  35 *> \date November 2011
  36 *
  37 *> \ingroup complex16_blas_level1
  38 *
  39 *  =====================================================================
  40       SUBROUTINE ZROTG(CA,CB,C,S)
  41 *
  42 *  -- Reference BLAS level1 routine (version 3.4.0) --
  43 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
  44 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  45 *     November 2011
  46 *
  47 *     .. Scalar Arguments ..
  48       COMPLEX*16 CA,CB,S
  49       DOUBLE PRECISION C
  50 *     ..
  51 *
  52 *  =====================================================================
  53 *
  54 *     .. Local Scalars ..
  55       COMPLEX*16 ALPHA
  56       DOUBLE PRECISION NORM,SCALE
  57 *     ..
  58 *     .. Intrinsic Functions ..
  59       INTRINSIC CDABS,DCMPLX,DCONJG,DSQRT
  60 *     ..
  61       IF (CDABS(CA).EQ.0.0d0) THEN
  62          C = 0.0d0
  63          S = (1.0d0,0.0d0)
  64          CA = CB
  65       ELSE
  66          SCALE = CDABS(CA) + CDABS(CB)
  67          NORM = SCALE*DSQRT((CDABS(CA/DCMPLX(SCALE,0.0d0)))**2+
  68      $       (CDABS(CB/DCMPLX(SCALE,0.0d0)))**2)
  69          ALPHA = CA/CDABS(CA)
  70          C = CDABS(CA)/NORM
  71          S = ALPHA*DCONJG(CB)/NORM
  72          CA = ALPHA*NORM
  73       END IF
  74       RETURN
  75       END