Return to zdrot.f CVS log

Up to [local] / rpl / lapack / blas

Annotation of rpl/lapack/blas/zdrot.f, revision 1.7

1.1       bertrand    1:       SUBROUTINE ZDROT( N, CX, INCX, CY, INCY, C, S )
                      2: *
                      3: *     .. Scalar Arguments ..
                      4:       INTEGER            INCX, INCY, N
                      5:       DOUBLE PRECISION   C, S
                      6: *     ..
                      7: *     .. Array Arguments ..
                      8:       COMPLEX*16         CX( * ), CY( * )
                      9: *     ..
                     10: *
                     11: *  Purpose
                     12: *  =======
                     13: *
                     14: *  Applies a plane rotation, where the cos and sin (c and s) are real
                     15: *  and the vectors cx and cy are complex.
                     16: *  jack dongarra, linpack, 3/11/78.
                     17: *
                     18: *  Arguments
                     19: *  ==========
                     20: *
                     21: *  N        (input) INTEGER
                     22: *           On entry, N specifies the order of the vectors cx and cy.
                     23: *           N must be at least zero.
                     24: *           Unchanged on exit.
                     25: *
                     26: *  CX       (input) COMPLEX*16 array, dimension at least
                     27: *           ( 1 + ( N - 1 )*abs( INCX ) ).
                     28: *           Before entry, the incremented array CX must contain the n
                     29: *           element vector cx. On exit, CX is overwritten by the updated
                     30: *           vector cx.
                     31: *
                     32: *  INCX     (input) INTEGER
                     33: *           On entry, INCX specifies the increment for the elements of
                     34: *           CX. INCX must not be zero.
                     35: *           Unchanged on exit.
                     36: *
                     37: *  CY       (input) COMPLEX*16 array, dimension at least
                     38: *           ( 1 + ( N - 1 )*abs( INCY ) ).
                     39: *           Before entry, the incremented array CY must contain the n
                     40: *           element vector cy. On exit, CY is overwritten by the updated
                     41: *           vector cy.
                     42: *
                     43: *  INCY     (input) INTEGER
                     44: *           On entry, INCY specifies the increment for the elements of
                     45: *           CY. INCY must not be zero.
                     46: *           Unchanged on exit.
                     47: *
                     48: *  C        (input) DOUBLE PRECISION
                     49: *           On entry, C specifies the cosine, cos.
                     50: *           Unchanged on exit.
                     51: *
                     52: *  S        (input) DOUBLE PRECISION
                     53: *           On entry, S specifies the sine, sin.
                     54: *           Unchanged on exit.
                     55: *
                     56: * =====================================================================
                     57: *
                     58: *     .. Local Scalars ..
                     59:       INTEGER            I, IX, IY
                     60:       COMPLEX*16         CTEMP
                     61: *     ..
                     62: *     .. Executable Statements ..
                     63: *
                     64:       IF( N.LE.0 )
                     65:      $   RETURN
1.7     ! bertrand   66:       IF( INCX.EQ.1 .AND. INCY.EQ.1 ) THEN
        !            67: *
        !            68: *        code for both increments equal to 1
        !            69: *
        !            70:          DO I = 1, N
        !            71:             CTEMP = C*CX( I ) + S*CY( I )
        !            72:             CY( I ) = C*CY( I ) - S*CX( I )
        !            73:             CX( I ) = CTEMP
        !            74:          END DO
        !            75:       ELSE
1.1       bertrand   76: *
                     77: *        code for unequal increments or equal increments not equal
                     78: *          to 1
                     79: *
1.7     ! bertrand   80:          IX = 1
        !            81:          IY = 1
        !            82:          IF( INCX.LT.0 )
        !            83:      $      IX = ( -N+1 )*INCX + 1
        !            84:          IF( INCY.LT.0 )
        !            85:      $      IY = ( -N+1 )*INCY + 1
        !            86:          DO I = 1, N
        !            87:             CTEMP = C*CX( IX ) + S*CY( IY )
        !            88:             CY( IY ) = C*CY( IY ) - S*CX( IX )
        !            89:             CX( IX ) = CTEMP
        !            90:             IX = IX + INCX
        !            91:             IY = IY + INCY
        !            92:          END DO
        !            93:       END IF
1.1       bertrand   94:       RETURN
                     95:       END