srotm Subroutine

public subroutine srotm(n, sx, incx, sy, incy, sparam)

NAME

srotm(3f) - [BLAS:SINGLE_BLAS_LEVEL1] Apply a modified Given's rotation.

SYNOPSIS

 subroutine srotm(n,sx,incx,sy,incy,sparam)

   .. Scalar Arguments ..
   integer,intent(in) :: incx,incy,n
   ..
   .. Array Arguments ..
   real,intent(in)    :: sparam(5)
   real,intent(inout) :: sx(*),sy(*)
   ..

DEFINITION

 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.

OPTIONS

N

       N is INTEGER
      number of elements in input vector(s)

SX

       SX is REAL array, dimension ( 1 + ( N - 1 )*abs( INCX ) )

INCX

       INCX is INTEGER
      storage spacing between elements of SX

SY

       SY is REAL array, dimension ( 1 + ( N - 1 )*abs( INCY ) )

INCY

       INCY is INTEGER
      storage spacing between elements of SY

SPARAM

       SPARAM is REAL array, dimension (5)
  SPARAM(1)=SFLAG
  SPARAM(2)=SH11
  SPARAM(3)=SH21
  SPARAM(4)=SH12
  SPARAM(5)=SH22

AUTHORS

  • Univ. of Tennessee
  • Univ. of California Berkeley
  • Univ. of Colorado Denver
  • NAG Ltd.

date:November 2017

SEE ALSO

Online html documentation available at
http://www.netlib.org/lapack/explore-html/

Arguments

Type IntentOptional Attributes Name
integer, intent(in) :: n
real, intent(inout) :: sx(*)
integer, intent(in) :: incx
real, intent(inout) :: sy(*)
integer, intent(in) :: incy
real, intent(in) :: sparam(5)

Contents

Variables

Source Code

srotm

Variables

Type Visibility Attributes Name Initial
integer, public :: i
integer, public :: kx
integer, public :: ky
integer, public :: nsteps
real, public :: sflag
real, public :: sh11
real, public :: sh12
real, public :: sh21
real, public :: sh22
real, public, parameter :: two = 2.0e0
real, public :: w
real, public :: z
real, public, parameter :: zero = 0.0e0

Source Code

       subroutine srotm(n,sx,incx,sy,incy,sparam)
      implicit none
!
!  -- 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,intent(in) :: incx,incy,n
!     ..
!     .. Array Arguments ..
      real,intent(in)    :: sparam(5)
      real,intent(inout) :: sx(*),sy(*)
!     ..
!
!  =====================================================================
!
!     .. Local Scalars ..
      real sflag,sh11,sh12,sh21,sh22,w,z
      real,parameter :: zero=0.0e0
      real,parameter :: two=2.0e0
      integer i,kx,ky,nsteps
!     ..
!
      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
            enddo
         elseif (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
            enddo
         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
            enddo
         endif
      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
            enddo
         elseif (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
            enddo
         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
            enddo
         endif
      endif

      end subroutine srotm