![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to drotm.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / lapack / blas|
Return to drotm.f CVS log | Up to [local] / rpl / lapack / blas |
1.1 bertrand 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
1.4 bertrand 68: IF (DFLAG.LT.ZERO) THEN
69: GO TO 50
70: ELSE IF (DFLAG.EQ.ZERO) THEN
71: GO TO 10
72: ELSE
73: GO TO 30
74: END IF
1.1 bertrand 75: 10 CONTINUE
76: DH12 = DPARAM(4)
77: DH21 = DPARAM(3)
78: DO 20 I = 1,NSTEPS,INCX
79: W = DX(I)
80: Z = DY(I)
81: DX(I) = W + Z*DH12
82: DY(I) = W*DH21 + Z
83: 20 CONTINUE
84: GO TO 140
85: 30 CONTINUE
86: DH11 = DPARAM(2)
87: DH22 = DPARAM(5)
88: DO 40 I = 1,NSTEPS,INCX
89: W = DX(I)
90: Z = DY(I)
91: DX(I) = W*DH11 + Z
92: DY(I) = -W + DH22*Z
93: 40 CONTINUE
94: GO TO 140
95: 50 CONTINUE
96: DH11 = DPARAM(2)
97: DH12 = DPARAM(4)
98: DH21 = DPARAM(3)
99: DH22 = DPARAM(5)
100: DO 60 I = 1,NSTEPS,INCX
101: W = DX(I)
102: Z = DY(I)
103: DX(I) = W*DH11 + Z*DH12
104: DY(I) = W*DH21 + Z*DH22
105: 60 CONTINUE
106: GO TO 140
107: 70 CONTINUE
108: KX = 1
109: KY = 1
110: IF (INCX.LT.0) KX = 1 + (1-N)*INCX
111: IF (INCY.LT.0) KY = 1 + (1-N)*INCY
112: *
1.4 bertrand 113: IF (DFLAG.LT.ZERO) THEN
114: GO TO 120
115: ELSE IF (DFLAG.EQ.ZERO) THEN
116: GO TO 80
117: ELSE
118: GO TO 100
119: END IF
1.1 bertrand 120: 80 CONTINUE
121: DH12 = DPARAM(4)
122: DH21 = DPARAM(3)
123: DO 90 I = 1,N
124: W = DX(KX)
125: Z = DY(KY)
126: DX(KX) = W + Z*DH12
127: DY(KY) = W*DH21 + Z
128: KX = KX + INCX
129: KY = KY + INCY
130: 90 CONTINUE
131: GO TO 140
132: 100 CONTINUE
133: DH11 = DPARAM(2)
134: DH22 = DPARAM(5)
135: DO 110 I = 1,N
136: W = DX(KX)
137: Z = DY(KY)
138: DX(KX) = W*DH11 + Z
139: DY(KY) = -W + DH22*Z
140: KX = KX + INCX
141: KY = KY + INCY
142: 110 CONTINUE
143: GO TO 140
144: 120 CONTINUE
145: DH11 = DPARAM(2)
146: DH12 = DPARAM(4)
147: DH21 = DPARAM(3)
148: DH22 = DPARAM(5)
149: DO 130 I = 1,N
150: W = DX(KX)
151: Z = DY(KY)
152: DX(KX) = W*DH11 + Z*DH12
153: DY(KY) = W*DH21 + Z*DH22
154: KX = KX + INCX
155: KY = KY + INCY
156: 130 CONTINUE
157: 140 CONTINUE
158: RETURN
159: END