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)) RETURN
65: IF (INCX.EQ.INCY.AND.INCX.GT.0) THEN
66: *
67: NSTEPS = N*INCX
68: IF (DFLAG.LT.ZERO) THEN
69: DH11 = DPARAM(2)
70: DH12 = DPARAM(4)
71: DH21 = DPARAM(3)
72: DH22 = DPARAM(5)
73: DO I = 1,NSTEPS,INCX
74: W = DX(I)
75: Z = DY(I)
76: DX(I) = W*DH11 + Z*DH12
77: DY(I) = W*DH21 + Z*DH22
78: END DO
79: ELSE IF (DFLAG.EQ.ZERO) THEN
80: DH12 = DPARAM(4)
81: DH21 = DPARAM(3)
82: DO I = 1,NSTEPS,INCX
83: W = DX(I)
84: Z = DY(I)
85: DX(I) = W + Z*DH12
86: DY(I) = W*DH21 + Z
87: END DO
88: ELSE
89: DH11 = DPARAM(2)
90: DH22 = DPARAM(5)
91: DO I = 1,NSTEPS,INCX
92: W = DX(I)
93: Z = DY(I)
94: DX(I) = W*DH11 + Z
95: DY(I) = -W + DH22*Z
96: END DO
97: END IF
98: ELSE
99: KX = 1
100: KY = 1
101: IF (INCX.LT.0) KX = 1 + (1-N)*INCX
102: IF (INCY.LT.0) KY = 1 + (1-N)*INCY
103: *
104: IF (DFLAG.LT.ZERO) THEN
105: DH11 = DPARAM(2)
106: DH12 = DPARAM(4)
107: DH21 = DPARAM(3)
108: DH22 = DPARAM(5)
109: DO I = 1,N
110: W = DX(KX)
111: Z = DY(KY)
112: DX(KX) = W*DH11 + Z*DH12
113: DY(KY) = W*DH21 + Z*DH22
114: KX = KX + INCX
115: KY = KY + INCY
116: END DO
117: ELSE IF (DFLAG.EQ.ZERO) THEN
118: DH12 = DPARAM(4)
119: DH21 = DPARAM(3)
120: DO I = 1,N
121: W = DX(KX)
122: Z = DY(KY)
123: DX(KX) = W + Z*DH12
124: DY(KY) = W*DH21 + Z
125: KX = KX + INCX
126: KY = KY + INCY
127: END DO
128: ELSE
129: DH11 = DPARAM(2)
130: DH22 = DPARAM(5)
131: DO I = 1,N
132: W = DX(KX)
133: Z = DY(KY)
134: DX(KX) = W*DH11 + Z
135: DY(KY) = -W + DH22*Z
136: KX = KX + INCX
137: KY = KY + INCY
138: END DO
139: END IF
140: END IF
141: RETURN
142: END
CVSweb interface <joel.bertrand@systella.fr>