LAPACK  3.7.1
LAPACK: Linear Algebra PACKage
drotm.f
Go to the documentation of this file.
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 December 2016
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.7.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 * December 2016
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
subroutine drotm(N, DX, INCX, DY, INCY, DPARAM)
DROTM
Definition: drotm.f:98