--- rpl/lapack/blas/drotm.f 2010/08/06 15:32:19 1.3 +++ rpl/lapack/blas/drotm.f 2023/08/07 08:38:43 1.17 @@ -1,54 +1,109 @@ - SUBROUTINE DROTM(N,DX,INCX,DY,INCY,DPARAM) -* .. Scalar Arguments .. - INTEGER INCX,INCY,N -* .. -* .. Array Arguments .. - DOUBLE PRECISION DPARAM(5),DX(*),DY(*) -* .. -* -* Purpose -* ======= -* -* APPLY THE MODIFIED GIVENS TRANSFORMATION, H, TO THE 2 BY N MATRIX -* -* (DX**T) , WHERE **T INDICATES TRANSPOSE. THE ELEMENTS OF DX ARE IN -* (DY**T) -* -* DX(LX+I*INCX), I = 0 TO N-1, WHERE LX = 1 IF INCX .GE. 0, ELSE -* LX = (-INCX)*N, AND SIMILARLY FOR SY USING LY AND INCY. -* WITH DPARAM(1)=DFLAG, H HAS ONE OF THE FOLLOWING FORMS.. -* -* DFLAG=-1.D0 DFLAG=0.D0 DFLAG=1.D0 DFLAG=-2.D0 +*> \brief \b DROTM * -* (DH11 DH12) (1.D0 DH12) (DH11 1.D0) (1.D0 0.D0) -* H=( ) ( ) ( ) ( ) -* (DH21 DH22), (DH21 1.D0), (-1.D0 DH22), (0.D0 1.D0). -* SEE DROTMG FOR A DESCRIPTION OF DATA STORAGE IN DPARAM. +* =========== DOCUMENTATION =========== * -* Arguments -* ========= +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ * -* N (input) INTEGER -* number of elements in input vector(s) +* Definition: +* =========== +* +* SUBROUTINE DROTM(N,DX,INCX,DY,INCY,DPARAM) +* +* .. Scalar Arguments .. +* INTEGER INCX,INCY,N +* .. +* .. Array Arguments .. +* DOUBLE PRECISION DPARAM(5),DX(*),DY(*) +* .. +* +* +*> \par Purpose: +* ============= +*> +*> \verbatim +*> +*> APPLY THE MODIFIED GIVENS TRANSFORMATION, H, TO THE 2 BY N MATRIX +*> +*> (DX**T) , WHERE **T INDICATES TRANSPOSE. THE ELEMENTS OF DX ARE IN +*> (DY**T) +*> +*> DX(LX+I*INCX), I = 0 TO N-1, WHERE LX = 1 IF INCX .GE. 0, ELSE +*> LX = (-INCX)*N, AND SIMILARLY FOR SY USING LY AND INCY. +*> WITH DPARAM(1)=DFLAG, H HAS ONE OF THE FOLLOWING FORMS.. +*> +*> DFLAG=-1.D0 DFLAG=0.D0 DFLAG=1.D0 DFLAG=-2.D0 +*> +*> (DH11 DH12) (1.D0 DH12) (DH11 1.D0) (1.D0 0.D0) +*> H=( ) ( ) ( ) ( ) +*> (DH21 DH22), (DH21 1.D0), (-1.D0 DH22), (0.D0 1.D0). +*> SEE DROTMG FOR A DESCRIPTION OF DATA STORAGE IN DPARAM. +*> \endverbatim +* +* Arguments: +* ========== +* +*> \param[in] N +*> \verbatim +*> N is INTEGER +*> number of elements in input vector(s) +*> \endverbatim +*> +*> \param[in,out] DX +*> \verbatim +*> DX is DOUBLE PRECISION array, dimension ( 1 + ( N - 1 )*abs( INCX ) ) +*> \endverbatim +*> +*> \param[in] INCX +*> \verbatim +*> INCX is INTEGER +*> storage spacing between elements of DX +*> \endverbatim +*> +*> \param[in,out] DY +*> \verbatim +*> DY is DOUBLE PRECISION array, dimension ( 1 + ( N - 1 )*abs( INCY ) ) +*> \endverbatim +*> +*> \param[in] INCY +*> \verbatim +*> INCY is INTEGER +*> storage spacing between elements of DY +*> \endverbatim +*> +*> \param[in] DPARAM +*> \verbatim +*> DPARAM is DOUBLE PRECISION array, dimension (5) +*> DPARAM(1)=DFLAG +*> DPARAM(2)=DH11 +*> DPARAM(3)=DH21 +*> DPARAM(4)=DH12 +*> DPARAM(5)=DH22 +*> \endverbatim +* +* Authors: +* ======== +* +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. * -* DX (input/output) DOUBLE PRECISION array, dimension N -* double precision vector with N elements +*> \ingroup double_blas_level1 * -* INCX (input) INTEGER -* storage spacing between elements of DX -* -* DY (input/output) DOUBLE PRECISION array, dimension N -* double precision vector with N elements +* ===================================================================== + SUBROUTINE DROTM(N,DX,INCX,DY,INCY,DPARAM) * -* INCY (input) INTEGER -* storage spacing between elements of DY +* -- Reference BLAS level1 routine -- +* -- Reference BLAS is a software package provided by Univ. of Tennessee, -- +* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * -* DPARAM (input/output) DOUBLE PRECISION array, dimension 5 -* DPARAM(1)=DFLAG -* DPARAM(2)=DH11 -* DPARAM(3)=DH21 -* DPARAM(4)=DH12 -* DPARAM(5)=DH22 +* .. Scalar Arguments .. + INTEGER INCX,INCY,N +* .. +* .. Array Arguments .. + DOUBLE PRECISION DPARAM(5),DX(*),DY(*) +* .. * * ===================================================================== * @@ -61,87 +116,85 @@ * .. * DFLAG = DPARAM(1) - IF (N.LE.0 .OR. (DFLAG+TWO.EQ.ZERO)) GO TO 140 - IF (.NOT. (INCX.EQ.INCY.AND.INCX.GT.0)) GO TO 70 + IF (N.LE.0 .OR. (DFLAG+TWO.EQ.ZERO)) RETURN + IF (INCX.EQ.INCY.AND.INCX.GT.0) THEN * - NSTEPS = N*INCX - IF (DFLAG) 50,10,30 - 10 CONTINUE - DH12 = DPARAM(4) - DH21 = DPARAM(3) - DO 20 I = 1,NSTEPS,INCX - W = DX(I) - Z = DY(I) - DX(I) = W + Z*DH12 - DY(I) = W*DH21 + Z - 20 CONTINUE - GO TO 140 - 30 CONTINUE - DH11 = DPARAM(2) - DH22 = DPARAM(5) - DO 40 I = 1,NSTEPS,INCX - W = DX(I) - Z = DY(I) - DX(I) = W*DH11 + Z - DY(I) = -W + DH22*Z - 40 CONTINUE - GO TO 140 - 50 CONTINUE - DH11 = DPARAM(2) - DH12 = DPARAM(4) - DH21 = DPARAM(3) - DH22 = DPARAM(5) - DO 60 I = 1,NSTEPS,INCX - W = DX(I) - Z = DY(I) - DX(I) = W*DH11 + Z*DH12 - DY(I) = W*DH21 + Z*DH22 - 60 CONTINUE - GO TO 140 - 70 CONTINUE - KX = 1 - KY = 1 - IF (INCX.LT.0) KX = 1 + (1-N)*INCX - IF (INCY.LT.0) KY = 1 + (1-N)*INCY -* - IF (DFLAG) 120,80,100 - 80 CONTINUE - DH12 = DPARAM(4) - DH21 = DPARAM(3) - DO 90 I = 1,N - W = DX(KX) - Z = DY(KY) - DX(KX) = W + Z*DH12 - DY(KY) = W*DH21 + Z - KX = KX + INCX - KY = KY + INCY - 90 CONTINUE - GO TO 140 - 100 CONTINUE - DH11 = DPARAM(2) - DH22 = DPARAM(5) - DO 110 I = 1,N - W = DX(KX) - Z = DY(KY) - DX(KX) = W*DH11 + Z - DY(KY) = -W + DH22*Z - KX = KX + INCX - KY = KY + INCY - 110 CONTINUE - GO TO 140 - 120 CONTINUE - DH11 = DPARAM(2) - DH12 = DPARAM(4) - DH21 = DPARAM(3) - DH22 = DPARAM(5) - DO 130 I = 1,N - W = DX(KX) - Z = DY(KY) - DX(KX) = W*DH11 + Z*DH12 - DY(KY) = W*DH21 + Z*DH22 - KX = KX + INCX - KY = KY + INCY - 130 CONTINUE - 140 CONTINUE + NSTEPS = N*INCX + IF (DFLAG.LT.ZERO) THEN + DH11 = DPARAM(2) + DH12 = DPARAM(4) + DH21 = DPARAM(3) + DH22 = DPARAM(5) + DO I = 1,NSTEPS,INCX + W = DX(I) + Z = DY(I) + DX(I) = W*DH11 + Z*DH12 + DY(I) = W*DH21 + Z*DH22 + END DO + ELSE IF (DFLAG.EQ.ZERO) THEN + DH12 = DPARAM(4) + DH21 = DPARAM(3) + DO I = 1,NSTEPS,INCX + W = DX(I) + Z = DY(I) + DX(I) = W + Z*DH12 + DY(I) = W*DH21 + Z + END DO + ELSE + DH11 = DPARAM(2) + DH22 = DPARAM(5) + DO I = 1,NSTEPS,INCX + W = DX(I) + Z = DY(I) + DX(I) = W*DH11 + Z + DY(I) = -W + DH22*Z + END DO + END IF + ELSE + KX = 1 + KY = 1 + IF (INCX.LT.0) KX = 1 + (1-N)*INCX + IF (INCY.LT.0) KY = 1 + (1-N)*INCY +* + IF (DFLAG.LT.ZERO) THEN + DH11 = DPARAM(2) + DH12 = DPARAM(4) + DH21 = DPARAM(3) + DH22 = DPARAM(5) + DO I = 1,N + W = DX(KX) + Z = DY(KY) + DX(KX) = W*DH11 + Z*DH12 + DY(KY) = W*DH21 + Z*DH22 + KX = KX + INCX + KY = KY + INCY + END DO + ELSE IF (DFLAG.EQ.ZERO) THEN + DH12 = DPARAM(4) + DH21 = DPARAM(3) + DO I = 1,N + W = DX(KX) + Z = DY(KY) + DX(KX) = W + Z*DH12 + DY(KY) = W*DH21 + Z + KX = KX + INCX + KY = KY + INCY + END DO + ELSE + DH11 = DPARAM(2) + DH22 = DPARAM(5) + DO I = 1,N + W = DX(KX) + Z = DY(KY) + DX(KX) = W*DH11 + Z + DY(KY) = -W + DH22*Z + KX = KX + INCX + KY = KY + INCY + END DO + END IF + END IF RETURN +* +* End of DROTM +* END