root / src / blas / srotm.f @ 4
Historique | Voir | Annoter | Télécharger (3,63 ko)
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(1),SY(1) |
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 5 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 |