SRC/crot.f

   1 *> \brief \b CROT applies a plane rotation with real cosine and complex sine to a pair of complex vectors.
   2 *
   3 *  =========== DOCUMENTATION ===========
   4 *
   5 * Online html documentation available at
   6 *            http://www.netlib.org/lapack/explore-html/
   7 *
   8 *> \htmlonly
   9 *> Download CROT + dependencies
  10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/crot.f">
  11 *> [TGZ]</a>
  12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/crot.f">
  13 *> [ZIP]</a>
  14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/crot.f">
  15 *> [TXT]</a>
  16 *> \endhtmlonly
  17 *
  18 *  Definition:
  19 *  ===========
  20 *
  21 *       SUBROUTINE CROT( N, CX, INCX, CY, INCY, C, S )
  22 *
  23 *       .. Scalar Arguments ..
  24 *       INTEGER            INCX, INCY, N
  25 *       REAL               C
  26 *       COMPLEX            S
  27 *       ..
  28 *       .. Array Arguments ..
  29 *       COMPLEX            CX( * ), CY( * )
  30 *       ..
  31 *
  32 *
  33 *> \par Purpose:
  34 *  =============
  35 *>
  36 *> \verbatim
  37 *>
  38 *> CROT   applies a plane rotation, where the cos (C) is real and the
  39 *> sin (S) is complex, and the vectors CX and CY are complex.
  40 *> \endverbatim
  41 *
  42 *  Arguments:
  43 *  ==========
  44 *
  45 *> \param[in] N
  46 *> \verbatim
  47 *>          N is INTEGER
  48 *>          The number of elements in the vectors CX and CY.
  49 *> \endverbatim
  50 *>
  51 *> \param[in,out] CX
  52 *> \verbatim
  53 *>          CX is COMPLEX array, dimension (N)
  54 *>          On input, the vector X.
  55 *>          On output, CX is overwritten with C*X + S*Y.
  56 *> \endverbatim
  57 *>
  58 *> \param[in] INCX
  59 *> \verbatim
  60 *>          INCX is INTEGER
  61 *>          The increment between successive values of CY.  INCX <> 0.
  62 *> \endverbatim
  63 *>
  64 *> \param[in,out] CY
  65 *> \verbatim
  66 *>          CY is COMPLEX array, dimension (N)
  67 *>          On input, the vector Y.
  68 *>          On output, CY is overwritten with -CONJG(S)*X + C*Y.
  69 *> \endverbatim
  70 *>
  71 *> \param[in] INCY
  72 *> \verbatim
  73 *>          INCY is INTEGER
  74 *>          The increment between successive values of CY.  INCX <> 0.
  75 *> \endverbatim
  76 *>
  77 *> \param[in] C
  78 *> \verbatim
  79 *>          C is REAL
  80 *> \endverbatim
  81 *>
  82 *> \param[in] S
  83 *> \verbatim
  84 *>          S is COMPLEX
  85 *>          C and S define a rotation
  86 *>             [  C          S  ]
  87 *>             [ -conjg(S)   C  ]
  88 *>          where C*C + S*CONJG(S) = 1.0.
  89 *> \endverbatim
  90 *
  91 *  Authors:
  92 *  ========
  93 *
  94 *> \author Univ. of Tennessee
  95 *> \author Univ. of California Berkeley
  96 *> \author Univ. of Colorado Denver
  97 *> \author NAG Ltd.
  98 *
  99 *> \date September 2012
 100 *
 101 *> \ingroup complexOTHERauxiliary
 102 *
 103 *  =====================================================================
 104       SUBROUTINE CROT( N, CX, INCX, CY, INCY, C, S )
 105 *
 106 *  -- LAPACK auxiliary routine (version 3.4.2) --
 107 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 108 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 109 *     September 2012
 110 *
 111 *     .. Scalar Arguments ..
 112       INTEGER            INCX, INCY, N
 113       REAL               C
 114       COMPLEX            S
 115 *     ..
 116 *     .. Array Arguments ..
 117       COMPLEX            CX( * ), CY( * )
 118 *     ..
 119 *
 120 * =====================================================================
 121 *
 122 *     .. Local Scalars ..
 123       INTEGER            I, IX, IY
 124       COMPLEX            STEMP
 125 *     ..
 126 *     .. Intrinsic Functions ..
 127       INTRINSIC          CONJG
 128 *     ..
 129 *     .. Executable Statements ..
 130 *
 131       IF( N.LE.0 )
 132      $   RETURN
 133       IF( INCX.EQ.1 .AND. INCY.EQ.1 )
 134      $   GO TO 20
 135 *
 136 *     Code for unequal increments or equal increments not equal to 1
 137 *
 138       IX = 1
 139       IY = 1
 140       IF( INCX.LT.0 )
 141      $   IX = ( -N+1 )*INCX + 1
 142       IF( INCY.LT.0 )
 143      $   IY = ( -N+1 )*INCY + 1
 144       DO 10 I = 1, N
 145          STEMP = C*CX( IX ) + S*CY( IY )
 146          CY( IY ) = C*CY( IY ) - CONJG( S )*CX( IX )
 147          CX( IX ) = STEMP
 148          IX = IX + INCX
 149          IY = IY + INCY
 150    10 CONTINUE
 151       RETURN
 152 *
 153 *     Code for both increments equal to 1
 154 *
 155    20 CONTINUE
 156       DO 30 I = 1, N
 157          STEMP = C*CX( I ) + S*CY( I )
 158          CY( I ) = C*CY( I ) - CONJG( S )*CX( I )
 159          CX( I ) = STEMP
 160    30 CONTINUE
 161       RETURN
 162       END