1 SUBROUTINE SROTM(N,SX,INCX,SY,INCY,SPARAM)
2 * .. Scalar Arguments ..
3 INTEGER INCX,INCY,N
4 * ..
5 * .. Array Arguments ..
6 REAL SPARAM(5),SX(*),SY(*)
7 * ..
8 *
9 * Purpose
10 * =======
11 *
12 * APPLY THE MODIFIED GIVENS TRANSFORMATION, H, TO THE 2 BY N MATRIX
13 *
14 * (SX**T) , WHERE **T INDICATES TRANSPOSE. THE ELEMENTS OF SX ARE IN
15 * (SX**T)
16 *
17 * SX(LX+I*INCX), I = 0 TO N-1, WHERE LX = 1 IF INCX .GE. 0, ELSE
18 * LX = (-INCX)*N, AND SIMILARLY FOR SY USING USING LY AND INCY.
19 * WITH SPARAM(1)=SFLAG, H HAS ONE OF THE FOLLOWING FORMS..
20 *
21 * SFLAG=-1.E0 SFLAG=0.E0 SFLAG=1.E0 SFLAG=-2.E0
22 *
23 * (SH11 SH12) (1.E0 SH12) (SH11 1.E0) (1.E0 0.E0)
24 * H=( ) ( ) ( ) ( )
25 * (SH21 SH22), (SH21 1.E0), (-1.E0 SH22), (0.E0 1.E0).
26 * SEE SROTMG FOR A DESCRIPTION OF DATA STORAGE IN SPARAM.
27 *
28 *
29 * Arguments
30 * =========
31 *
32 * N (input) INTEGER
33 * number of elements in input vector(s)
34 *
35 * SX (input/output) REAL array, dimension N
36 * double precision vector with N elements
37 *
38 * INCX (input) INTEGER
39 * storage spacing between elements of SX
40 *
41 * SY (input/output) REAL array, dimension N
42 * double precision vector with N elements
43 *
44 * INCY (input) INTEGER
45 * storage spacing between elements of SY
46 *
47 * SPARAM (input/output) REAL array, dimension 5
48 * SPARAM(1)=SFLAG
49 * SPARAM(2)=SH11
50 * SPARAM(3)=SH21
51 * SPARAM(4)=SH12
52 * SPARAM(5)=SH22
53 *
54 * =====================================================================
55 *
56 * .. Local Scalars ..
57 REAL SFLAG,SH11,SH12,SH21,SH22,TWO,W,Z,ZERO
58 INTEGER I,KX,KY,NSTEPS
59 * ..
60 * .. Data statements ..
61 DATA ZERO,TWO/0.E0,2.E0/
62 * ..
63 *
64 SFLAG = SPARAM(1)
65 IF (N.LE.0 .OR. (SFLAG+TWO.EQ.ZERO)) RETURN
66 IF (INCX.EQ.INCY.AND.INCX.GT.0) THEN
67 *
68 NSTEPS = N*INCX
69 IF (SFLAG.LT.ZERO) THEN
70 SH11 = SPARAM(2)
71 SH12 = SPARAM(4)
72 SH21 = SPARAM(3)
73 SH22 = SPARAM(5)
74 DO I = 1,NSTEPS,INCX
75 W = SX(I)
76 Z = SY(I)
77 SX(I) = W*SH11 + Z*SH12
78 SY(I) = W*SH21 + Z*SH22
79 END DO
80 ELSE IF (SFLAG.EQ.ZERO) THEN
81 SH12 = SPARAM(4)
82 SH21 = SPARAM(3)
83 DO I = 1,NSTEPS,INCX
84 W = SX(I)
85 Z = SY(I)
86 SX(I) = W + Z*SH12
87 SY(I) = W*SH21 + Z
88 END DO
89 ELSE
90 SH11 = SPARAM(2)
91 SH22 = SPARAM(5)
92 DO I = 1,NSTEPS,INCX
93 W = SX(I)
94 Z = SY(I)
95 SX(I) = W*SH11 + Z
96 SY(I) = -W + SH22*Z
97 END DO
98 END IF
99 ELSE
100 KX = 1
101 KY = 1
102 IF (INCX.LT.0) KX = 1 + (1-N)*INCX
103 IF (INCY.LT.0) KY = 1 + (1-N)*INCY
104 *
105 IF (SFLAG.LT.ZERO) THEN
106 SH11 = SPARAM(2)
107 SH12 = SPARAM(4)
108 SH21 = SPARAM(3)
109 SH22 = SPARAM(5)
110 DO I = 1,N
111 W = SX(KX)
112 Z = SY(KY)
113 SX(KX) = W*SH11 + Z*SH12
114 SY(KY) = W*SH21 + Z*SH22
115 KX = KX + INCX
116 KY = KY + INCY
117 END DO
118 ELSE IF (SFLAG.EQ.ZERO) THEN
119 SH12 = SPARAM(4)
120 SH21 = SPARAM(3)
121 DO I = 1,N
122 W = SX(KX)
123 Z = SY(KY)
124 SX(KX) = W + Z*SH12
125 SY(KY) = W*SH21 + Z
126 KX = KX + INCX
127 KY = KY + INCY
128 END DO
129 ELSE
130 SH11 = SPARAM(2)
131 SH22 = SPARAM(5)
132 DO I = 1,N
133 W = SX(KX)
134 Z = SY(KY)
135 SX(KX) = W*SH11 + Z
136 SY(KY) = -W + SH22*Z
137 KX = KX + INCX
138 KY = KY + INCY
139 END DO
140 END IF
141 END IF
142 RETURN
143 END
2 * .. Scalar Arguments ..
3 INTEGER INCX,INCY,N
4 * ..
5 * .. Array Arguments ..
6 REAL SPARAM(5),SX(*),SY(*)
7 * ..
8 *
9 * Purpose
10 * =======
11 *
12 * APPLY THE MODIFIED GIVENS TRANSFORMATION, H, TO THE 2 BY N MATRIX
13 *
14 * (SX**T) , WHERE **T INDICATES TRANSPOSE. THE ELEMENTS OF SX ARE IN
15 * (SX**T)
16 *
17 * SX(LX+I*INCX), I = 0 TO N-1, WHERE LX = 1 IF INCX .GE. 0, ELSE
18 * LX = (-INCX)*N, AND SIMILARLY FOR SY USING USING LY AND INCY.
19 * WITH SPARAM(1)=SFLAG, H HAS ONE OF THE FOLLOWING FORMS..
20 *
21 * SFLAG=-1.E0 SFLAG=0.E0 SFLAG=1.E0 SFLAG=-2.E0
22 *
23 * (SH11 SH12) (1.E0 SH12) (SH11 1.E0) (1.E0 0.E0)
24 * H=( ) ( ) ( ) ( )
25 * (SH21 SH22), (SH21 1.E0), (-1.E0 SH22), (0.E0 1.E0).
26 * SEE SROTMG FOR A DESCRIPTION OF DATA STORAGE IN SPARAM.
27 *
28 *
29 * Arguments
30 * =========
31 *
32 * N (input) INTEGER
33 * number of elements in input vector(s)
34 *
35 * SX (input/output) REAL array, dimension N
36 * double precision vector with N elements
37 *
38 * INCX (input) INTEGER
39 * storage spacing between elements of SX
40 *
41 * SY (input/output) REAL array, dimension N
42 * double precision vector with N elements
43 *
44 * INCY (input) INTEGER
45 * storage spacing between elements of SY
46 *
47 * SPARAM (input/output) REAL array, dimension 5
48 * SPARAM(1)=SFLAG
49 * SPARAM(2)=SH11
50 * SPARAM(3)=SH21
51 * SPARAM(4)=SH12
52 * SPARAM(5)=SH22
53 *
54 * =====================================================================
55 *
56 * .. Local Scalars ..
57 REAL SFLAG,SH11,SH12,SH21,SH22,TWO,W,Z,ZERO
58 INTEGER I,KX,KY,NSTEPS
59 * ..
60 * .. Data statements ..
61 DATA ZERO,TWO/0.E0,2.E0/
62 * ..
63 *
64 SFLAG = SPARAM(1)
65 IF (N.LE.0 .OR. (SFLAG+TWO.EQ.ZERO)) RETURN
66 IF (INCX.EQ.INCY.AND.INCX.GT.0) THEN
67 *
68 NSTEPS = N*INCX
69 IF (SFLAG.LT.ZERO) THEN
70 SH11 = SPARAM(2)
71 SH12 = SPARAM(4)
72 SH21 = SPARAM(3)
73 SH22 = SPARAM(5)
74 DO I = 1,NSTEPS,INCX
75 W = SX(I)
76 Z = SY(I)
77 SX(I) = W*SH11 + Z*SH12
78 SY(I) = W*SH21 + Z*SH22
79 END DO
80 ELSE IF (SFLAG.EQ.ZERO) THEN
81 SH12 = SPARAM(4)
82 SH21 = SPARAM(3)
83 DO I = 1,NSTEPS,INCX
84 W = SX(I)
85 Z = SY(I)
86 SX(I) = W + Z*SH12
87 SY(I) = W*SH21 + Z
88 END DO
89 ELSE
90 SH11 = SPARAM(2)
91 SH22 = SPARAM(5)
92 DO I = 1,NSTEPS,INCX
93 W = SX(I)
94 Z = SY(I)
95 SX(I) = W*SH11 + Z
96 SY(I) = -W + SH22*Z
97 END DO
98 END IF
99 ELSE
100 KX = 1
101 KY = 1
102 IF (INCX.LT.0) KX = 1 + (1-N)*INCX
103 IF (INCY.LT.0) KY = 1 + (1-N)*INCY
104 *
105 IF (SFLAG.LT.ZERO) THEN
106 SH11 = SPARAM(2)
107 SH12 = SPARAM(4)
108 SH21 = SPARAM(3)
109 SH22 = SPARAM(5)
110 DO I = 1,N
111 W = SX(KX)
112 Z = SY(KY)
113 SX(KX) = W*SH11 + Z*SH12
114 SY(KY) = W*SH21 + Z*SH22
115 KX = KX + INCX
116 KY = KY + INCY
117 END DO
118 ELSE IF (SFLAG.EQ.ZERO) THEN
119 SH12 = SPARAM(4)
120 SH21 = SPARAM(3)
121 DO I = 1,N
122 W = SX(KX)
123 Z = SY(KY)
124 SX(KX) = W + Z*SH12
125 SY(KY) = W*SH21 + Z
126 KX = KX + INCX
127 KY = KY + INCY
128 END DO
129 ELSE
130 SH11 = SPARAM(2)
131 SH22 = SPARAM(5)
132 DO I = 1,N
133 W = SX(KX)
134 Z = SY(KY)
135 SX(KX) = W*SH11 + Z
136 SY(KY) = -W + SH22*Z
137 KX = KX + INCX
138 KY = KY + INCY
139 END DO
140 END IF
141 END IF
142 RETURN
143 END