File:
[local] /
rpl /
lapack /
lapack /
dlarf.f
Revision
1.14:
download - view:
text,
annotated -
select for diffs -
revision graph
Mon Jan 27 09:28:21 2014 UTC (10 years, 7 months ago) by
bertrand
Branches:
MAIN
CVS tags:
rpl-4_1_24,
rpl-4_1_23,
rpl-4_1_22,
rpl-4_1_21,
rpl-4_1_20,
rpl-4_1_19,
rpl-4_1_18,
rpl-4_1_17,
HEAD
Cohérence.
1: *> \brief \b DLARF applies an elementary reflector to a general rectangular matrix.
2: *
3: * =========== DOCUMENTATION ===========
4: *
5: * Online html documentation available at
6: * http://www.netlib.org/lapack/explore-html/
7: *
8: *> \htmlonly
9: *> Download DLARF + dependencies
10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlarf.f">
11: *> [TGZ]</a>
12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlarf.f">
13: *> [ZIP]</a>
14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlarf.f">
15: *> [TXT]</a>
16: *> \endhtmlonly
17: *
18: * Definition:
19: * ===========
20: *
21: * SUBROUTINE DLARF( SIDE, M, N, V, INCV, TAU, C, LDC, WORK )
22: *
23: * .. Scalar Arguments ..
24: * CHARACTER SIDE
25: * INTEGER INCV, LDC, M, N
26: * DOUBLE PRECISION TAU
27: * ..
28: * .. Array Arguments ..
29: * DOUBLE PRECISION C( LDC, * ), V( * ), WORK( * )
30: * ..
31: *
32: *
33: *> \par Purpose:
34: * =============
35: *>
36: *> \verbatim
37: *>
38: *> DLARF applies a real elementary reflector H to a real m by n matrix
39: *> C, from either the left or the right. H is represented in the form
40: *>
41: *> H = I - tau * v * v**T
42: *>
43: *> where tau is a real scalar and v is a real vector.
44: *>
45: *> If tau = 0, then H is taken to be the unit matrix.
46: *> \endverbatim
47: *
48: * Arguments:
49: * ==========
50: *
51: *> \param[in] SIDE
52: *> \verbatim
53: *> SIDE is CHARACTER*1
54: *> = 'L': form H * C
55: *> = 'R': form C * H
56: *> \endverbatim
57: *>
58: *> \param[in] M
59: *> \verbatim
60: *> M is INTEGER
61: *> The number of rows of the matrix C.
62: *> \endverbatim
63: *>
64: *> \param[in] N
65: *> \verbatim
66: *> N is INTEGER
67: *> The number of columns of the matrix C.
68: *> \endverbatim
69: *>
70: *> \param[in] V
71: *> \verbatim
72: *> V is DOUBLE PRECISION array, dimension
73: *> (1 + (M-1)*abs(INCV)) if SIDE = 'L'
74: *> or (1 + (N-1)*abs(INCV)) if SIDE = 'R'
75: *> The vector v in the representation of H. V is not used if
76: *> TAU = 0.
77: *> \endverbatim
78: *>
79: *> \param[in] INCV
80: *> \verbatim
81: *> INCV is INTEGER
82: *> The increment between elements of v. INCV <> 0.
83: *> \endverbatim
84: *>
85: *> \param[in] TAU
86: *> \verbatim
87: *> TAU is DOUBLE PRECISION
88: *> The value tau in the representation of H.
89: *> \endverbatim
90: *>
91: *> \param[in,out] C
92: *> \verbatim
93: *> C is DOUBLE PRECISION array, dimension (LDC,N)
94: *> On entry, the m by n matrix C.
95: *> On exit, C is overwritten by the matrix H * C if SIDE = 'L',
96: *> or C * H if SIDE = 'R'.
97: *> \endverbatim
98: *>
99: *> \param[in] LDC
100: *> \verbatim
101: *> LDC is INTEGER
102: *> The leading dimension of the array C. LDC >= max(1,M).
103: *> \endverbatim
104: *>
105: *> \param[out] WORK
106: *> \verbatim
107: *> WORK is DOUBLE PRECISION array, dimension
108: *> (N) if SIDE = 'L'
109: *> or (M) if SIDE = 'R'
110: *> \endverbatim
111: *
112: * Authors:
113: * ========
114: *
115: *> \author Univ. of Tennessee
116: *> \author Univ. of California Berkeley
117: *> \author Univ. of Colorado Denver
118: *> \author NAG Ltd.
119: *
120: *> \date September 2012
121: *
122: *> \ingroup doubleOTHERauxiliary
123: *
124: * =====================================================================
125: SUBROUTINE DLARF( SIDE, M, N, V, INCV, TAU, C, LDC, WORK )
126: *
127: * -- LAPACK auxiliary routine (version 3.4.2) --
128: * -- LAPACK is a software package provided by Univ. of Tennessee, --
129: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
130: * September 2012
131: *
132: * .. Scalar Arguments ..
133: CHARACTER SIDE
134: INTEGER INCV, LDC, M, N
135: DOUBLE PRECISION TAU
136: * ..
137: * .. Array Arguments ..
138: DOUBLE PRECISION C( LDC, * ), V( * ), WORK( * )
139: * ..
140: *
141: * =====================================================================
142: *
143: * .. Parameters ..
144: DOUBLE PRECISION ONE, ZERO
145: PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
146: * ..
147: * .. Local Scalars ..
148: LOGICAL APPLYLEFT
149: INTEGER I, LASTV, LASTC
150: * ..
151: * .. External Subroutines ..
152: EXTERNAL DGEMV, DGER
153: * ..
154: * .. External Functions ..
155: LOGICAL LSAME
156: INTEGER ILADLR, ILADLC
157: EXTERNAL LSAME, ILADLR, ILADLC
158: * ..
159: * .. Executable Statements ..
160: *
161: APPLYLEFT = LSAME( SIDE, 'L' )
162: LASTV = 0
163: LASTC = 0
164: IF( TAU.NE.ZERO ) THEN
165: ! Set up variables for scanning V. LASTV begins pointing to the end
166: ! of V.
167: IF( APPLYLEFT ) THEN
168: LASTV = M
169: ELSE
170: LASTV = N
171: END IF
172: IF( INCV.GT.0 ) THEN
173: I = 1 + (LASTV-1) * INCV
174: ELSE
175: I = 1
176: END IF
177: ! Look for the last non-zero row in V.
178: DO WHILE( LASTV.GT.0 .AND. V( I ).EQ.ZERO )
179: LASTV = LASTV - 1
180: I = I - INCV
181: END DO
182: IF( APPLYLEFT ) THEN
183: ! Scan for the last non-zero column in C(1:lastv,:).
184: LASTC = ILADLC(LASTV, N, C, LDC)
185: ELSE
186: ! Scan for the last non-zero row in C(:,1:lastv).
187: LASTC = ILADLR(M, LASTV, C, LDC)
188: END IF
189: END IF
190: ! Note that lastc.eq.0 renders the BLAS operations null; no special
191: ! case is needed at this level.
192: IF( APPLYLEFT ) THEN
193: *
194: * Form H * C
195: *
196: IF( LASTV.GT.0 ) THEN
197: *
198: * w(1:lastc,1) := C(1:lastv,1:lastc)**T * v(1:lastv,1)
199: *
200: CALL DGEMV( 'Transpose', LASTV, LASTC, ONE, C, LDC, V, INCV,
201: $ ZERO, WORK, 1 )
202: *
203: * C(1:lastv,1:lastc) := C(...) - v(1:lastv,1) * w(1:lastc,1)**T
204: *
205: CALL DGER( LASTV, LASTC, -TAU, V, INCV, WORK, 1, C, LDC )
206: END IF
207: ELSE
208: *
209: * Form C * H
210: *
211: IF( LASTV.GT.0 ) THEN
212: *
213: * w(1:lastc,1) := C(1:lastc,1:lastv) * v(1:lastv,1)
214: *
215: CALL DGEMV( 'No transpose', LASTC, LASTV, ONE, C, LDC,
216: $ V, INCV, ZERO, WORK, 1 )
217: *
218: * C(1:lastc,1:lastv) := C(...) - w(1:lastc,1) * v(1:lastv,1)**T
219: *
220: CALL DGER( LASTC, LASTV, -TAU, WORK, 1, V, INCV, C, LDC )
221: END IF
222: END IF
223: RETURN
224: *
225: * End of DLARF
226: *
227: END
CVSweb interface <joel.bertrand@systella.fr>