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
CVSweb interface <joel.bertrand@systella.fr>