Gitiles
Code Review Sign In
realtimeroboticsgroup.org / RealtimeRoboticsGroup / test / c44d0d7211e0912562eed939410d594b23b51a43 / . / third_party / eigen / blas / srotm.f
blob: fc5a59333525d5865877702c4c8722dc4fc5de21 [file] [log] [blame]
Brian Silverman72890c22015-09-19 14:37:37 -0400[diff] [blame]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* (DX**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)) GO TO 140
66 IF (.NOT. (INCX.EQ.INCY.AND.INCX.GT.0)) GO TO 70
67*
68 NSTEPS = N*INCX
69 IF (SFLAG) 50,10,30
70 10 CONTINUE
71 SH12 = SPARAM(4)
72 SH21 = SPARAM(3)
73 DO 20 I = 1,NSTEPS,INCX
74 W = SX(I)
75 Z = SY(I)
76 SX(I) = W + Z*SH12
77 SY(I) = W*SH21 + Z
78 20 CONTINUE
79 GO TO 140
80 30 CONTINUE
81 SH11 = SPARAM(2)
82 SH22 = SPARAM(5)
83 DO 40 I = 1,NSTEPS,INCX
84 W = SX(I)
85 Z = SY(I)
86 SX(I) = W*SH11 + Z
87 SY(I) = -W + SH22*Z
88 40 CONTINUE
89 GO TO 140
90 50 CONTINUE
91 SH11 = SPARAM(2)
92 SH12 = SPARAM(4)
93 SH21 = SPARAM(3)
94 SH22 = SPARAM(5)
95 DO 60 I = 1,NSTEPS,INCX
96 W = SX(I)
97 Z = SY(I)
98 SX(I) = W*SH11 + Z*SH12
99 SY(I) = W*SH21 + Z*SH22
100 60 CONTINUE
101 GO TO 140
102 70 CONTINUE
103 KX = 1
104 KY = 1
105 IF (INCX.LT.0) KX = 1 + (1-N)*INCX
106 IF (INCY.LT.0) KY = 1 + (1-N)*INCY
107*
108 IF (SFLAG) 120,80,100
109 80 CONTINUE
110 SH12 = SPARAM(4)
111 SH21 = SPARAM(3)
112 DO 90 I = 1,N
113 W = SX(KX)
114 Z = SY(KY)
115 SX(KX) = W + Z*SH12
116 SY(KY) = W*SH21 + Z
117 KX = KX + INCX
118 KY = KY + INCY
119 90 CONTINUE
120 GO TO 140
121 100 CONTINUE
122 SH11 = SPARAM(2)
123 SH22 = SPARAM(5)
124 DO 110 I = 1,N
125 W = SX(KX)
126 Z = SY(KY)
127 SX(KX) = W*SH11 + Z
128 SY(KY) = -W + SH22*Z
129 KX = KX + INCX
130 KY = KY + INCY
131 110 CONTINUE
132 GO TO 140
133 120 CONTINUE
134 SH11 = SPARAM(2)
135 SH12 = SPARAM(4)
136 SH21 = SPARAM(3)
137 SH22 = SPARAM(5)
138 DO 130 I = 1,N
139 W = SX(KX)
140 Z = SY(KY)
141 SX(KX) = W*SH11 + Z*SH12
142 SY(KY) = W*SH21 + Z*SH22
143 KX = KX + INCX
144 KY = KY + INCY
145 130 CONTINUE
146 140 CONTINUE
147 RETURN
148 END