d1/dbb/csrot_8f_source.html

00001       SUBROUTINE CSROT( N, CX, INCX, CY, INCY, C, S )
00002 *
00003 *     .. Scalar Arguments ..
00004       INTEGER           INCX, INCY, N
00005       REAL              C, S
00006 *     ..
00007 *     .. Array Arguments ..
00008       COMPLEX           CX( * ), CY( * )
00009 *     ..
00010 *
00011 *  Purpose
00012 *  =======
00013 *
00014 *  CSROT applies a plane rotation, where the cos and sin (c and s) are real
00015 *  and the vectors cx and cy are complex.
00016 *  jack dongarra, linpack, 3/11/78.
00017 *
00018 *  Arguments
00019 *  ==========
00020 *
00021 *  N        (input) INTEGER
00022 *           On entry, N specifies the order of the vectors cx and cy.
00023 *           N must be at least zero.
00024 *           Unchanged on exit.
00025 *
00026 *  CX       (input) COMPLEX array, dimension at least
00027 *           ( 1 + ( N - 1 )*abs( INCX ) ).
00028 *           Before entry, the incremented array CX must contain the n
00029 *           element vector cx. On exit, CX is overwritten by the updated
00030 *           vector cx.
00031 *
00032 *  INCX     (input) INTEGER
00033 *           On entry, INCX specifies the increment for the elements of
00034 *           CX. INCX must not be zero.
00035 *           Unchanged on exit.
00036 *
00037 *  CY       (input) COMPLEX array, dimension at least
00038 *           ( 1 + ( N - 1 )*abs( INCY ) ).
00039 *           Before entry, the incremented array CY must contain the n
00040 *           element vector cy. On exit, CY is overwritten by the updated
00041 *           vector cy.
00042 *
00043 *  INCY     (input) INTEGER
00044 *           On entry, INCY specifies the increment for the elements of
00045 *           CY. INCY must not be zero.
00046 *           Unchanged on exit.
00047 *
00048 *  C        (input) REAL
00049 *           On entry, C specifies the cosine, cos.
00050 *           Unchanged on exit.
00051 *
00052 *  S        (input) REAL
00053 *           On entry, S specifies the sine, sin.
00054 *           Unchanged on exit.
00055 *
00056 *  =====================================================================
00057 *
00058 *     .. Local Scalars ..
00059       INTEGER           I, IX, IY
00060       COMPLEX           CTEMP
00061 *     ..
00062 *     .. Executable Statements ..
00063 *
00064       IF( N.LE.0 )
00065      $   RETURN
00066       IF( INCX.EQ.1 .AND. INCY.EQ.1 )
00067      $   GO TO 20
00068 *
00069 *        code for unequal increments or equal increments not equal
00070 *          to 1
00071 *
00072       IX = 1
00073       IY = 1
00074       IF( INCX.LT.0 )
00075      $   IX = ( -N+1 )*INCX + 1
00076       IF( INCY.LT.0 )
00077      $   IY = ( -N+1 )*INCY + 1
00078       DO 10 I = 1, N
00079          CTEMP = C*CX( IX ) + S*CY( IY )
00080          CY( IY ) = C*CY( IY ) - S*CX( IX )
00081          CX( IX ) = CTEMP
00082          IX = IX + INCX
00083          IY = IY + INCY
00084    10 CONTINUE
00085       RETURN
00086 *
00087 *        code for both increments equal to 1
00088 *
00089    20 DO 30 I = 1, N
00090          CTEMP = C*CX( I ) + S*CY( I )
00091          CY( I ) = C*CY( I ) - S*CX( I )
00092          CX( I ) = CTEMP
00093    30 CONTINUE
00094       RETURN
00095       END