d3/dc1/crot_8f_source.html

00001       SUBROUTINE CROT( N, CX, INCX, CY, INCY, C, S )
00002 *
00003 *  -- LAPACK auxiliary routine (version 3.2) --
00004 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00005 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00006 *     November 2006
00007 *
00008 *     .. Scalar Arguments ..
00009       INTEGER            INCX, INCY, N
00010       REAL               C
00011       COMPLEX            S
00012 *     ..
00013 *     .. Array Arguments ..
00014       COMPLEX            CX( * ), CY( * )
00015 *     ..
00016 *
00017 *  Purpose
00018 *  =======
00019 *
00020 *  CROT   applies a plane rotation, where the cos (C) is real and the
00021 *  sin (S) is complex, and the vectors CX and CY are complex.
00022 *
00023 *  Arguments
00024 *  =========
00025 *
00026 *  N       (input) INTEGER
00027 *          The number of elements in the vectors CX and CY.
00028 *
00029 *  CX      (input/output) COMPLEX array, dimension (N)
00030 *          On input, the vector X.
00031 *          On output, CX is overwritten with C*X + S*Y.
00032 *
00033 *  INCX    (input) INTEGER
00034 *          The increment between successive values of CY.  INCX <> 0.
00035 *
00036 *  CY      (input/output) COMPLEX array, dimension (N)
00037 *          On input, the vector Y.
00038 *          On output, CY is overwritten with -CONJG(S)*X + C*Y.
00039 *
00040 *  INCY    (input) INTEGER
00041 *          The increment between successive values of CY.  INCX <> 0.
00042 *
00043 *  C       (input) REAL
00044 *  S       (input) COMPLEX
00045 *          C and S define a rotation
00046 *             [  C          S  ]
00047 *             [ -conjg(S)   C  ]
00048 *          where C*C + S*CONJG(S) = 1.0.
00049 *
00050 * =====================================================================
00051 *
00052 *     .. Local Scalars ..
00053       INTEGER            I, IX, IY
00054       COMPLEX            STEMP
00055 *     ..
00056 *     .. Intrinsic Functions ..
00057       INTRINSIC          CONJG
00058 *     ..
00059 *     .. Executable Statements ..
00060 *
00061       IF( N.LE.0 )
00062      $   RETURN
00063       IF( INCX.EQ.1 .AND. INCY.EQ.1 )
00064      $   GO TO 20
00065 *
00066 *     Code for unequal increments or equal increments not equal to 1
00067 *
00068       IX = 1
00069       IY = 1
00070       IF( INCX.LT.0 )
00071      $   IX = ( -N+1 )*INCX + 1
00072       IF( INCY.LT.0 )
00073      $   IY = ( -N+1 )*INCY + 1
00074       DO 10 I = 1, N
00075          STEMP = C*CX( IX ) + S*CY( IY )
00076          CY( IY ) = C*CY( IY ) - CONJG( S )*CX( IX )
00077          CX( IX ) = STEMP
00078          IX = IX + INCX
00079          IY = IY + INCY
00080    10 CONTINUE
00081       RETURN
00082 *
00083 *     Code for both increments equal to 1
00084 *
00085    20 CONTINUE
00086       DO 30 I = 1, N
00087          STEMP = C*CX( I ) + S*CY( I )
00088          CY( I ) = C*CY( I ) - CONJG( S )*CX( I )
00089          CX( I ) = STEMP
00090    30 CONTINUE
00091       RETURN
00092       END