source: pacpussensors/trunk/Vislab/lib3dv/eigen/blas/drotm.f@ 140

Last change on this file since 140 was 136, checked in by ldecherf, 8 years ago

Doc

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