LAPACK  3.5.0
LAPACK: Linear Algebra PACKage
 All Classes Files Functions Variables Typedefs Macros
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 N
55 *> double precision vector with N elements
56 *> \endverbatim
57 *>
58 *> \param[in] INCX
59 *> \verbatim
60 *> INCX is INTEGER
61 *> storage spacing between elements of DX
62 *> \endverbatim
63 *>
64 *> \param[in,out] DY
65 *> \verbatim
66 *> DY is DOUBLE PRECISION array, dimension N
67 *> double precision vector with N elements
68 *> \endverbatim
69 *>
70 *> \param[in] INCY
71 *> \verbatim
72 *> INCY is INTEGER
73 *> storage spacing between elements of DY
74 *> \endverbatim
75 *>
76 *> \param[in,out] DPARAM
77 *> \verbatim
78 *> DPARAM is DOUBLE PRECISION array, dimension 5
79 *> DPARAM(1)=DFLAG
80 *> DPARAM(2)=DH11
81 *> DPARAM(3)=DH21
82 *> DPARAM(4)=DH12
83 *> DPARAM(5)=DH22
84 *> \endverbatim
85 *
86 * Authors:
87 * ========
88 *
89 *> \author Univ. of Tennessee
90 *> \author Univ. of California Berkeley
91 *> \author Univ. of Colorado Denver
92 *> \author NAG Ltd.
93 *
94 *> \date November 2011
95 *
96 *> \ingroup double_blas_level1
97 *
98 * =====================================================================
99  SUBROUTINE drotm(N,DX,INCX,DY,INCY,DPARAM)
100 *
101 * -- Reference BLAS level1 routine (version 3.4.0) --
102 * -- Reference BLAS is a software package provided by Univ. of Tennessee, --
103 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
104 * November 2011
105 *
106 * .. Scalar Arguments ..
107  INTEGER incx,incy,n
108 * ..
109 * .. Array Arguments ..
110  DOUBLE PRECISION dparam(5),dx(*),dy(*)
111 * ..
112 *
113 * =====================================================================
114 *
115 * .. Local Scalars ..
116  DOUBLE PRECISION dflag,dh11,dh12,dh21,dh22,two,w,z,zero
117  INTEGER i,kx,ky,nsteps
118 * ..
119 * .. Data statements ..
120  DATA zero,two/0.d0,2.d0/
121 * ..
122 *
123  dflag = dparam(1)
124  IF (n.LE.0 .OR. (dflag+two.EQ.zero)) RETURN
125  IF (incx.EQ.incy.AND.incx.GT.0) THEN
126 *
127  nsteps = n*incx
128  IF (dflag.LT.zero) THEN
129  dh11 = dparam(2)
130  dh12 = dparam(4)
131  dh21 = dparam(3)
132  dh22 = dparam(5)
133  DO i = 1,nsteps,incx
134  w = dx(i)
135  z = dy(i)
136  dx(i) = w*dh11 + z*dh12
137  dy(i) = w*dh21 + z*dh22
138  END DO
139  ELSE IF (dflag.EQ.zero) THEN
140  dh12 = dparam(4)
141  dh21 = dparam(3)
142  DO i = 1,nsteps,incx
143  w = dx(i)
144  z = dy(i)
145  dx(i) = w + z*dh12
146  dy(i) = w*dh21 + z
147  END DO
148  ELSE
149  dh11 = dparam(2)
150  dh22 = dparam(5)
151  DO i = 1,nsteps,incx
152  w = dx(i)
153  z = dy(i)
154  dx(i) = w*dh11 + z
155  dy(i) = -w + dh22*z
156  END DO
157  END IF
158  ELSE
159  kx = 1
160  ky = 1
161  IF (incx.LT.0) kx = 1 + (1-n)*incx
162  IF (incy.LT.0) ky = 1 + (1-n)*incy
163 *
164  IF (dflag.LT.zero) THEN
165  dh11 = dparam(2)
166  dh12 = dparam(4)
167  dh21 = dparam(3)
168  dh22 = dparam(5)
169  DO i = 1,n
170  w = dx(kx)
171  z = dy(ky)
172  dx(kx) = w*dh11 + z*dh12
173  dy(ky) = w*dh21 + z*dh22
174  kx = kx + incx
175  ky = ky + incy
176  END DO
177  ELSE IF (dflag.EQ.zero) THEN
178  dh12 = dparam(4)
179  dh21 = dparam(3)
180  DO i = 1,n
181  w = dx(kx)
182  z = dy(ky)
183  dx(kx) = w + z*dh12
184  dy(ky) = w*dh21 + z
185  kx = kx + incx
186  ky = ky + incy
187  END DO
188  ELSE
189  dh11 = dparam(2)
190  dh22 = dparam(5)
191  DO i = 1,n
192  w = dx(kx)
193  z = dy(ky)
194  dx(kx) = w*dh11 + z
195  dy(ky) = -w + dh22*z
196  kx = kx + incx
197  ky = ky + incy
198  END DO
199  END IF
200  END IF
201  RETURN
202  END