00001 SUBROUTINE ZDROT( N, CX, INCX, CY, INCY, C, S ) 00002 * 00003 * .. Scalar Arguments .. 00004 INTEGER INCX, INCY, N 00005 DOUBLE PRECISION C, S 00006 * .. 00007 * .. Array Arguments .. 00008 COMPLEX*16 CX( * ), CY( * ) 00009 * .. 00010 * 00011 * Purpose 00012 * ======= 00013 * 00014 * 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*16 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*16 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) DOUBLE PRECISION 00049 * On entry, C specifies the cosine, cos. 00050 * Unchanged on exit. 00051 * 00052 * S (input) DOUBLE PRECISION 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*16 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 CONTINUE 00090 DO 30 I = 1, N 00091 CTEMP = C*CX( I ) + S*CY( I ) 00092 CY( I ) = C*CY( I ) - S*CX( I ) 00093 CX( I ) = CTEMP 00094 30 CONTINUE 00095 RETURN 00096 END
1.7.2