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
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