diff options
author | jason <jason@8a072113-8704-0410-8d35-dd094bca7971> | 2008-10-28 01:38:50 +0000 |
---|---|---|
committer | jason <jason@8a072113-8704-0410-8d35-dd094bca7971> | 2008-10-28 01:38:50 +0000 |
commit | baba851215b44ac3b60b9248eb02bcce7eb76247 (patch) | |
tree | 8c0f5c006875532a30d4409f5e94b0f310ff00a7 /SRC/clacrt.f | |
download | lapack-baba851215b44ac3b60b9248eb02bcce7eb76247.tar.gz lapack-baba851215b44ac3b60b9248eb02bcce7eb76247.tar.bz2 lapack-baba851215b44ac3b60b9248eb02bcce7eb76247.zip |
Move LAPACK trunk into position.
Diffstat (limited to 'SRC/clacrt.f')
-rw-r--r-- | SRC/clacrt.f | 90 |
1 files changed, 90 insertions, 0 deletions
diff --git a/SRC/clacrt.f b/SRC/clacrt.f new file mode 100644 index 00000000..71f6203d --- /dev/null +++ b/SRC/clacrt.f @@ -0,0 +1,90 @@ + SUBROUTINE CLACRT( N, CX, INCX, CY, INCY, C, S ) +* +* -- LAPACK auxiliary routine (version 3.1) -- +* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. +* November 2006 +* +* .. Scalar Arguments .. + INTEGER INCX, INCY, N + COMPLEX C, S +* .. +* .. Array Arguments .. + COMPLEX CX( * ), CY( * ) +* .. +* +* Purpose +* ======= +* +* CLACRT performs the operation +* +* ( c s )( x ) ==> ( x ) +* ( -s c )( y ) ( y ) +* +* where c and s are complex and the vectors x and y are complex. +* +* Arguments +* ========= +* +* N (input) INTEGER +* The number of elements in the vectors CX and CY. +* +* CX (input/output) COMPLEX array, dimension (N) +* On input, the vector x. +* On output, CX is overwritten with c*x + s*y. +* +* INCX (input) INTEGER +* The increment between successive values of CX. INCX <> 0. +* +* CY (input/output) COMPLEX array, dimension (N) +* On input, the vector y. +* On output, CY is overwritten with -s*x + c*y. +* +* INCY (input) INTEGER +* The increment between successive values of CY. INCY <> 0. +* +* C (input) COMPLEX +* S (input) COMPLEX +* C and S define the matrix +* [ C S ]. +* [ -S C ] +* +* ===================================================================== +* +* .. Local Scalars .. + INTEGER I, IX, IY + COMPLEX CTEMP +* .. +* .. Executable Statements .. +* + IF( N.LE.0 ) + $ RETURN + IF( INCX.EQ.1 .AND. INCY.EQ.1 ) + $ GO TO 20 +* +* Code for unequal increments or equal increments not equal to 1 +* + IX = 1 + IY = 1 + IF( INCX.LT.0 ) + $ IX = ( -N+1 )*INCX + 1 + IF( INCY.LT.0 ) + $ IY = ( -N+1 )*INCY + 1 + DO 10 I = 1, N + CTEMP = C*CX( IX ) + S*CY( IY ) + CY( IY ) = C*CY( IY ) - S*CX( IX ) + CX( IX ) = CTEMP + IX = IX + INCX + IY = IY + INCY + 10 CONTINUE + RETURN +* +* Code for both increments equal to 1 +* + 20 CONTINUE + DO 30 I = 1, N + CTEMP = C*CX( I ) + S*CY( I ) + CY( I ) = C*CY( I ) - S*CX( I ) + CX( I ) = CTEMP + 30 CONTINUE + RETURN + END |