d5/d56/zlacrt_8f_source.html

00001       SUBROUTINE ZLACRT( 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       COMPLEX*16         C, S
00011 *     ..
00012 *     .. Array Arguments ..
00013       COMPLEX*16         CX( * ), CY( * )
00014 *     ..
00015 *
00016 *  Purpose
00017 *  =======
00018 *
00019 *  ZLACRT performs the operation
00020 *
00021 *     (  c  s )( x )  ==> ( x )
00022 *     ( -s  c )( y )      ( y )
00023 *
00024 *  where c and s are complex and the vectors x and y are complex.
00025 *
00026 *  Arguments
00027 *  =========
00028 *
00029 *  N       (input) INTEGER
00030 *          The number of elements in the vectors CX and CY.
00031 *
00032 *  CX      (input/output) COMPLEX*16 array, dimension (N)
00033 *          On input, the vector x.
00034 *          On output, CX is overwritten with c*x + s*y.
00035 *
00036 *  INCX    (input) INTEGER
00037 *          The increment between successive values of CX.  INCX <> 0.
00038 *
00039 *  CY      (input/output) COMPLEX*16 array, dimension (N)
00040 *          On input, the vector y.
00041 *          On output, CY is overwritten with -s*x + c*y.
00042 *
00043 *  INCY    (input) INTEGER
00044 *          The increment between successive values of CY.  INCY <> 0.
00045 *
00046 *  C       (input) COMPLEX*16
00047 *  S       (input) COMPLEX*16
00048 *          C and S define the matrix
00049 *             [  C   S  ].
00050 *             [ -S   C  ]
00051 *
00052 * =====================================================================
00053 *
00054 *     .. Local Scalars ..
00055       INTEGER            I, IX, IY
00056       COMPLEX*16         CTEMP
00057 *     ..
00058 *     .. Executable Statements ..
00059 *
00060       IF( N.LE.0 )
00061      $   RETURN
00062       IF( INCX.EQ.1 .AND. INCY.EQ.1 )
00063      $   GO TO 20
00064 *
00065 *     Code for unequal increments or equal increments not equal to 1
00066 *
00067       IX = 1
00068       IY = 1
00069       IF( INCX.LT.0 )
00070      $   IX = ( -N+1 )*INCX + 1
00071       IF( INCY.LT.0 )
00072      $   IY = ( -N+1 )*INCY + 1
00073       DO 10 I = 1, N
00074          CTEMP = C*CX( IX ) + S*CY( IY )
00075          CY( IY ) = C*CY( IY ) - S*CX( IX )
00076          CX( IX ) = CTEMP
00077          IX = IX + INCX
00078          IY = IY + INCY
00079    10 CONTINUE
00080       RETURN
00081 *
00082 *     Code for both increments equal to 1
00083 *
00084    20 CONTINUE
00085       DO 30 I = 1, N
00086          CTEMP = C*CX( I ) + S*CY( I )
00087          CY( I ) = C*CY( I ) - S*CX( I )
00088          CX( I ) = CTEMP
00089    30 CONTINUE
00090       RETURN
00091       END