1: *> \brief \b DROTM
2: *
3: * =========== DOCUMENTATION ===========
4: *
5: * Online html documentation available at
6: * http://www.netlib.org/lapack/explore-html/
7: *
8: * Definition:
9: * ===========
10: *
11: * SUBROUTINE DROTM(N,DX,INCX,DY,INCY,DPARAM)
12: *
13: * .. Scalar Arguments ..
14: * INTEGER INCX,INCY,N
15: * ..
16: * .. Array Arguments ..
17: * DOUBLE PRECISION DPARAM(5),DX(*),DY(*)
18: * ..
19: *
20: *
21: *> \par Purpose:
22: * =============
23: *>
24: *> \verbatim
25: *>
26: *> APPLY THE MODIFIED GIVENS TRANSFORMATION, H, TO THE 2 BY N MATRIX
27: *>
28: *> (DX**T) , WHERE **T INDICATES TRANSPOSE. THE ELEMENTS OF DX ARE IN
29: *> (DY**T)
30: *>
31: *> DX(LX+I*INCX), I = 0 TO N-1, WHERE LX = 1 IF INCX .GE. 0, ELSE
32: *> LX = (-INCX)*N, AND SIMILARLY FOR SY USING LY AND INCY.
33: *> WITH DPARAM(1)=DFLAG, H HAS ONE OF THE FOLLOWING FORMS..
34: *>
35: *> DFLAG=-1.D0 DFLAG=0.D0 DFLAG=1.D0 DFLAG=-2.D0
36: *>
37: *> (DH11 DH12) (1.D0 DH12) (DH11 1.D0) (1.D0 0.D0)
38: *> H=( ) ( ) ( ) ( )
39: *> (DH21 DH22), (DH21 1.D0), (-1.D0 DH22), (0.D0 1.D0).
40: *> SEE DROTMG FOR A DESCRIPTION OF DATA STORAGE IN DPARAM.
41: *> \endverbatim
42: *
43: * Arguments:
44: * ==========
45: *
46: *> \param[in] N
47: *> \verbatim
48: *> N is INTEGER
49: *> number of elements in input vector(s)
50: *> \endverbatim
51: *>
52: *> \param[in,out] DX
53: *> \verbatim
54: *> DX is DOUBLE PRECISION array, dimension ( 1 + ( N - 1 )*abs( INCX ) )
55: *> \endverbatim
56: *>
57: *> \param[in] INCX
58: *> \verbatim
59: *> INCX is INTEGER
60: *> storage spacing between elements of DX
61: *> \endverbatim
62: *>
63: *> \param[in,out] DY
64: *> \verbatim
65: *> DY is DOUBLE PRECISION array, dimension ( 1 + ( N - 1 )*abs( INCY ) )
66: *> \endverbatim
67: *>
68: *> \param[in] INCY
69: *> \verbatim
70: *> INCY is INTEGER
71: *> storage spacing between elements of DY
72: *> \endverbatim
73: *>
74: *> \param[in] DPARAM
75: *> \verbatim
76: *> DPARAM is DOUBLE PRECISION array, dimension (5)
77: *> DPARAM(1)=DFLAG
78: *> DPARAM(2)=DH11
79: *> DPARAM(3)=DH21
80: *> DPARAM(4)=DH12
81: *> DPARAM(5)=DH22
82: *> \endverbatim
83: *
84: * Authors:
85: * ========
86: *
87: *> \author Univ. of Tennessee
88: *> \author Univ. of California Berkeley
89: *> \author Univ. of Colorado Denver
90: *> \author NAG Ltd.
91: *
92: *> \date November 2017
93: *
94: *> \ingroup double_blas_level1
95: *
96: * =====================================================================
97: SUBROUTINE DROTM(N,DX,INCX,DY,INCY,DPARAM)
98: *
99: * -- Reference BLAS level1 routine (version 3.8.0) --
100: * -- Reference BLAS is a software package provided by Univ. of Tennessee, --
101: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
102: * November 2017
103: *
104: * .. Scalar Arguments ..
105: INTEGER INCX,INCY,N
106: * ..
107: * .. Array Arguments ..
108: DOUBLE PRECISION DPARAM(5),DX(*),DY(*)
109: * ..
110: *
111: * =====================================================================
112: *
113: * .. Local Scalars ..
114: DOUBLE PRECISION DFLAG,DH11,DH12,DH21,DH22,TWO,W,Z,ZERO
115: INTEGER I,KX,KY,NSTEPS
116: * ..
117: * .. Data statements ..
118: DATA ZERO,TWO/0.D0,2.D0/
119: * ..
120: *
121: DFLAG = DPARAM(1)
122: IF (N.LE.0 .OR. (DFLAG+TWO.EQ.ZERO)) RETURN
123: IF (INCX.EQ.INCY.AND.INCX.GT.0) THEN
124: *
125: NSTEPS = N*INCX
126: IF (DFLAG.LT.ZERO) THEN
127: DH11 = DPARAM(2)
128: DH12 = DPARAM(4)
129: DH21 = DPARAM(3)
130: DH22 = DPARAM(5)
131: DO I = 1,NSTEPS,INCX
132: W = DX(I)
133: Z = DY(I)
134: DX(I) = W*DH11 + Z*DH12
135: DY(I) = W*DH21 + Z*DH22
136: END DO
137: ELSE IF (DFLAG.EQ.ZERO) THEN
138: DH12 = DPARAM(4)
139: DH21 = DPARAM(3)
140: DO I = 1,NSTEPS,INCX
141: W = DX(I)
142: Z = DY(I)
143: DX(I) = W + Z*DH12
144: DY(I) = W*DH21 + Z
145: END DO
146: ELSE
147: DH11 = DPARAM(2)
148: DH22 = DPARAM(5)
149: DO I = 1,NSTEPS,INCX
150: W = DX(I)
151: Z = DY(I)
152: DX(I) = W*DH11 + Z
153: DY(I) = -W + DH22*Z
154: END DO
155: END IF
156: ELSE
157: KX = 1
158: KY = 1
159: IF (INCX.LT.0) KX = 1 + (1-N)*INCX
160: IF (INCY.LT.0) KY = 1 + (1-N)*INCY
161: *
162: IF (DFLAG.LT.ZERO) THEN
163: DH11 = DPARAM(2)
164: DH12 = DPARAM(4)
165: DH21 = DPARAM(3)
166: DH22 = DPARAM(5)
167: DO I = 1,N
168: W = DX(KX)
169: Z = DY(KY)
170: DX(KX) = W*DH11 + Z*DH12
171: DY(KY) = W*DH21 + Z*DH22
172: KX = KX + INCX
173: KY = KY + INCY
174: END DO
175: ELSE IF (DFLAG.EQ.ZERO) THEN
176: DH12 = DPARAM(4)
177: DH21 = DPARAM(3)
178: DO I = 1,N
179: W = DX(KX)
180: Z = DY(KY)
181: DX(KX) = W + Z*DH12
182: DY(KY) = W*DH21 + Z
183: KX = KX + INCX
184: KY = KY + INCY
185: END DO
186: ELSE
187: DH11 = DPARAM(2)
188: DH22 = DPARAM(5)
189: DO I = 1,N
190: W = DX(KX)
191: Z = DY(KY)
192: DX(KX) = W*DH11 + Z
193: DY(KY) = -W + DH22*Z
194: KX = KX + INCX
195: KY = KY + INCY
196: END DO
197: END IF
198: END IF
199: RETURN
200: END
CVSweb interface <joel.bertrand@systella.fr>