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