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
1.7.2