LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ srotm()

subroutine srotm ( integer  n,
real, dimension(*)  sx,
integer  incx,
real, dimension(*)  sy,
integer  incy,
real, dimension(5)  sparam 
)

SROTM

Purpose:
    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.
Parameters
[in]N
          N is INTEGER
         number of elements in input vector(s)
[in,out]SX
          SX is REAL array, dimension ( 1 + ( N - 1 )*abs( INCX ) )
[in]INCX
          INCX is INTEGER
         storage spacing between elements of SX
[in,out]SY
          SY is REAL array, dimension ( 1 + ( N - 1 )*abs( INCY ) )
[in]INCY
          INCY is INTEGER
         storage spacing between elements of SY
[in]SPARAM
          SPARAM is REAL array, dimension (5)
     SPARAM(1)=SFLAG
     SPARAM(2)=SH11
     SPARAM(3)=SH21
     SPARAM(4)=SH12
     SPARAM(5)=SH22
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

Definition at line 96 of file srotm.f.

97*
98* -- Reference BLAS level1 routine --
99* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
100* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
101*
102* .. Scalar Arguments ..
103 INTEGER INCX,INCY,N
104* ..
105* .. Array Arguments ..
106 REAL SPARAM(5),SX(*),SY(*)
107* ..
108*
109* =====================================================================
110*
111* .. Local Scalars ..
112 REAL SFLAG,SH11,SH12,SH21,SH22,TWO,W,Z,ZERO
113 INTEGER I,KX,KY,NSTEPS
114* ..
115* .. Data statements ..
116 DATA zero,two/0.e0,2.e0/
117* ..
118*
119 sflag = sparam(1)
120 IF (n.LE.0 .OR. (sflag+two.EQ.zero)) RETURN
121 IF (incx.EQ.incy.AND.incx.GT.0) THEN
122*
123 nsteps = n*incx
124 IF (sflag.LT.zero) THEN
125 sh11 = sparam(2)
126 sh12 = sparam(4)
127 sh21 = sparam(3)
128 sh22 = sparam(5)
129 DO i = 1,nsteps,incx
130 w = sx(i)
131 z = sy(i)
132 sx(i) = w*sh11 + z*sh12
133 sy(i) = w*sh21 + z*sh22
134 END DO
135 ELSE IF (sflag.EQ.zero) THEN
136 sh12 = sparam(4)
137 sh21 = sparam(3)
138 DO i = 1,nsteps,incx
139 w = sx(i)
140 z = sy(i)
141 sx(i) = w + z*sh12
142 sy(i) = w*sh21 + z
143 END DO
144 ELSE
145 sh11 = sparam(2)
146 sh22 = sparam(5)
147 DO i = 1,nsteps,incx
148 w = sx(i)
149 z = sy(i)
150 sx(i) = w*sh11 + z
151 sy(i) = -w + sh22*z
152 END DO
153 END IF
154 ELSE
155 kx = 1
156 ky = 1
157 IF (incx.LT.0) kx = 1 + (1-n)*incx
158 IF (incy.LT.0) ky = 1 + (1-n)*incy
159*
160 IF (sflag.LT.zero) THEN
161 sh11 = sparam(2)
162 sh12 = sparam(4)
163 sh21 = sparam(3)
164 sh22 = sparam(5)
165 DO i = 1,n
166 w = sx(kx)
167 z = sy(ky)
168 sx(kx) = w*sh11 + z*sh12
169 sy(ky) = w*sh21 + z*sh22
170 kx = kx + incx
171 ky = ky + incy
172 END DO
173 ELSE IF (sflag.EQ.zero) THEN
174 sh12 = sparam(4)
175 sh21 = sparam(3)
176 DO i = 1,n
177 w = sx(kx)
178 z = sy(ky)
179 sx(kx) = w + z*sh12
180 sy(ky) = w*sh21 + z
181 kx = kx + incx
182 ky = ky + incy
183 END DO
184 ELSE
185 sh11 = sparam(2)
186 sh22 = sparam(5)
187 DO i = 1,n
188 w = sx(kx)
189 z = sy(ky)
190 sx(kx) = w*sh11 + z
191 sy(ky) = -w + sh22*z
192 kx = kx + incx
193 ky = ky + incy
194 END DO
195 END IF
196 END IF
197 RETURN
198*
199* End of SROTM
200*
Here is the caller graph for this function: