srotm.f

Go to the documentation of this file.

*> \brief \b SROTM
*
*  =========== DOCUMENTATION ===========
*
* Online html documentation available at
*            http://www.netlib.org/lapack/explore-html/
*
*  Definition:
*  ===========
*
*       SUBROUTINE SROTM(N,SX,INCX,SY,INCY,SPARAM)
*
*       .. Scalar Arguments ..
*       INTEGER INCX,INCY,N
*       ..
*       .. Array Arguments ..
*       REAL SPARAM(5),SX(*),SY(*)
*       ..
*
*
*> \par Purpose:
*  =============
*>
*> \verbatim
*>
*>    APPLY THE MODIFIED GIVENS TRANSFORMATION, H, TO THE 2 BY N MATRIX
*>
*>    (SX**T) , WHERE **T INDICATES TRANSPOSE. THE ELEMENTS OF SX ARE IN
*>    (SX**T)
*>
*>    SX(LX+I*INCX), I = 0 TO N-1, WHERE LX = 1 IF INCX .GE. 0, ELSE
*>    LX = (-INCX)*N, AND SIMILARLY FOR SY USING USING LY AND INCY.
*>    WITH SPARAM(1)=SFLAG, H HAS ONE OF THE FOLLOWING FORMS..
*>
*>    SFLAG=-1.E0     SFLAG=0.E0        SFLAG=1.E0     SFLAG=-2.E0
*>
*>      (SH11  SH12)    (1.E0  SH12)    (SH11  1.E0)    (1.E0  0.E0)
*>    H=(          )    (          )    (          )    (          )
*>      (SH21  SH22),   (SH21  1.E0),   (-1.E0 SH22),   (0.E0  1.E0).
*>    SEE  SROTMG FOR A DESCRIPTION OF DATA STORAGE IN SPARAM.
*>
*> \endverbatim
*
*  Arguments:
*  ==========
*
*> \param[in] N
*> \verbatim
*>          N is INTEGER
*>         number of elements in input vector(s)
*> \endverbatim
*>
*> \param[in,out] SX
*> \verbatim
*>          SX is REAL array, dimension ( 1 + ( N - 1 )*abs( INCX ) )
*> \endverbatim
*>
*> \param[in] INCX
*> \verbatim
*>          INCX is INTEGER
*>         storage spacing between elements of SX
*> \endverbatim
*>
*> \param[in,out] SY
*> \verbatim
*>          SY is REAL array, dimension ( 1 + ( N - 1 )*abs( INCY ) )
*> \endverbatim
*>
*> \param[in] INCY
*> \verbatim
*>          INCY is INTEGER
*>         storage spacing between elements of SY
*> \endverbatim
*>
*> \param[in] SPARAM
*> \verbatim
*>          SPARAM is REAL array, dimension (5)
*>     SPARAM(1)=SFLAG
*>     SPARAM(2)=SH11
*>     SPARAM(3)=SH21
*>     SPARAM(4)=SH12
*>     SPARAM(5)=SH22
*> \endverbatim
*
*  Authors:
*  ========
*
*> \author Univ. of Tennessee
*> \author Univ. of California Berkeley
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date November 2017
*
*> \ingroup single_blas_level1
*
*  =====================================================================
      SUBROUTINE srotm(N,SX,INCX,SY,INCY,SPARAM)
*
*  -- Reference BLAS level1 routine (version 3.8.0) --
*  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
*     November 2017
*
*     .. Scalar Arguments ..
      INTEGER INCX,INCY,N
*     ..
*     .. Array Arguments ..
      REAL SPARAM(5),SX(*),SY(*)
*     ..
*
*  =====================================================================
*
*     .. Local Scalars ..
      REAL SFLAG,SH11,SH12,SH21,SH22,TWO,W,Z,ZERO
      INTEGER I,KX,KY,NSTEPS
*     ..
*     .. Data statements ..
      DATA zero,two/0.e0,2.e0/
*     ..
*
      sflag = sparam(1)
      IF (n.LE.0 .OR. (sflag+two.EQ.zero)) RETURN
      IF (incx.EQ.incy.AND.incx.GT.0) THEN
*
         nsteps = n*incx
         IF (sflag.LT.zero) THEN
            sh11 = sparam(2)
            sh12 = sparam(4)
            sh21 = sparam(3)
            sh22 = sparam(5)
            DO i = 1,nsteps,incx
               w = sx(i)
               z = sy(i)
               sx(i) = w*sh11 + z*sh12
               sy(i) = w*sh21 + z*sh22
            END DO
         ELSE IF (sflag.EQ.zero) THEN
            sh12 = sparam(4)
            sh21 = sparam(3)
            DO i = 1,nsteps,incx
               w = sx(i)
               z = sy(i)
               sx(i) = w + z*sh12
               sy(i) = w*sh21 + z
            END DO
         ELSE
            sh11 = sparam(2)
            sh22 = sparam(5)
            DO i = 1,nsteps,incx
               w = sx(i)
               z = sy(i)
               sx(i) = w*sh11 + z
               sy(i) = -w + sh22*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 (sflag.LT.zero) THEN
            sh11 = sparam(2)
            sh12 = sparam(4)
            sh21 = sparam(3)
            sh22 = sparam(5)
            DO i = 1,n
               w = sx(kx)
               z = sy(ky)
               sx(kx) = w*sh11 + z*sh12
               sy(ky) = w*sh21 + z*sh22
               kx = kx + incx
               ky = ky + incy
            END DO
         ELSE IF (sflag.EQ.zero) THEN
            sh12 = sparam(4)
            sh21 = sparam(3)
            DO i = 1,n
               w = sx(kx)
               z = sy(ky)
               sx(kx) = w + z*sh12
               sy(ky) = w*sh21 + z
               kx = kx + incx
               ky = ky + incy
            END DO
         ELSE
             sh11 = sparam(2)
             sh22 = sparam(5)
             DO i = 1,n
                w = sx(kx)
                z = sy(ky)
                sx(kx) = w*sh11 + z
                sy(ky) = -w + sh22*z
                kx = kx + incx
                ky = ky + incy
            END DO
         END IF
      END IF
      RETURN
      END