--- rpl/lapack/blas/drot.f 2010/08/13 21:03:39 1.5 +++ rpl/lapack/blas/drot.f 2017/06/17 10:53:43 1.13 @@ -1,4 +1,61 @@ +*> \brief \b DROT +* +* =========== DOCUMENTATION =========== +* +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ +* +* Definition: +* =========== +* +* SUBROUTINE DROT(N,DX,INCX,DY,INCY,C,S) +* +* .. Scalar Arguments .. +* DOUBLE PRECISION C,S +* INTEGER INCX,INCY,N +* .. +* .. Array Arguments .. +* DOUBLE PRECISION DX(*),DY(*) +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> DROT applies a plane rotation. +*> \endverbatim +* +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. +* +*> \date December 2016 +* +*> \ingroup double_blas_level1 +* +*> \par Further Details: +* ===================== +*> +*> \verbatim +*> +*> jack dongarra, linpack, 3/11/78. +*> modified 12/3/93, array(1) declarations changed to array(*) +*> \endverbatim +*> +* ===================================================================== SUBROUTINE DROT(N,DX,INCX,DY,INCY,C,S) +* +* -- Reference BLAS level1 routine (version 3.7.0) -- +* -- Reference BLAS is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- +* December 2016 +* * .. Scalar Arguments .. DOUBLE PRECISION C,S INTEGER INCX,INCY,N @@ -7,17 +64,6 @@ DOUBLE PRECISION DX(*),DY(*) * .. * -* Purpose -* ======= -* -* DROT applies a plane rotation. -* -* Further Details -* =============== -* -* jack dongarra, linpack, 3/11/78. -* modified 12/3/93, array(1) declarations changed to array(*) -* * ===================================================================== * * .. Local Scalars .. @@ -25,30 +71,31 @@ INTEGER I,IX,IY * .. IF (N.LE.0) RETURN - IF (INCX.EQ.1 .AND. INCY.EQ.1) GO TO 20 + IF (INCX.EQ.1 .AND. INCY.EQ.1) THEN * -* code for unequal increments or equal increments not equal -* to 1 +* code for both increments 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 - DTEMP = C*DX(IX) + S*DY(IY) - DY(IY) = C*DY(IY) - S*DX(IX) - DX(IX) = DTEMP - IX = IX + INCX - IY = IY + INCY - 10 CONTINUE - RETURN + DO I = 1,N + DTEMP = C*DX(I) + S*DY(I) + DY(I) = C*DY(I) - S*DX(I) + DX(I) = DTEMP + END DO + ELSE * -* code for both increments equal to 1 +* code for unequal increments or equal increments not equal +* to 1 * - 20 DO 30 I = 1,N - DTEMP = C*DX(I) + S*DY(I) - DY(I) = C*DY(I) - S*DX(I) - DX(I) = DTEMP - 30 CONTINUE + IX = 1 + IY = 1 + IF (INCX.LT.0) IX = (-N+1)*INCX + 1 + IF (INCY.LT.0) IY = (-N+1)*INCY + 1 + DO I = 1,N + DTEMP = C*DX(IX) + S*DY(IY) + DY(IY) = C*DY(IY) - S*DX(IX) + DX(IX) = DTEMP + IX = IX + INCX + IY = IY + INCY + END DO + END IF RETURN END