• Home
  • History
  • Annotate
  • Line#
  • Scopes#
  • Navigate#
  • Raw
  • Download
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
149