Annotation of rpl/lapack/lapack/dlarf.f, revision 1.19
1.12 bertrand 1: *> \brief \b DLARF applies an elementary reflector to a general rectangular matrix.
1.9 bertrand 2: *
3: * =========== DOCUMENTATION ===========
4: *
1.16 bertrand 5: * Online html documentation available at
6: * http://www.netlib.org/lapack/explore-html/
1.9 bertrand 7: *
8: *> \htmlonly
1.16 bertrand 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">
1.9 bertrand 15: *> [TXT]</a>
1.16 bertrand 16: *> \endhtmlonly
1.9 bertrand 17: *
18: * Definition:
19: * ===========
20: *
21: * SUBROUTINE DLARF( SIDE, M, N, V, INCV, TAU, C, LDC, WORK )
1.16 bertrand 22: *
1.9 bertrand 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: * ..
1.16 bertrand 31: *
1.9 bertrand 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: *
1.16 bertrand 115: *> \author Univ. of Tennessee
116: *> \author Univ. of California Berkeley
117: *> \author Univ. of Colorado Denver
118: *> \author NAG Ltd.
1.9 bertrand 119: *
120: *> \ingroup doubleOTHERauxiliary
121: *
122: * =====================================================================
1.1 bertrand 123: SUBROUTINE DLARF( SIDE, M, N, V, INCV, TAU, C, LDC, WORK )
124: *
1.19 ! bertrand 125: * -- LAPACK auxiliary routine --
1.1 bertrand 126: * -- LAPACK is a software package provided by Univ. of Tennessee, --
127: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
128: *
129: * .. Scalar Arguments ..
130: CHARACTER SIDE
131: INTEGER INCV, LDC, M, N
132: DOUBLE PRECISION TAU
133: * ..
134: * .. Array Arguments ..
135: DOUBLE PRECISION C( LDC, * ), V( * ), WORK( * )
136: * ..
137: *
138: * =====================================================================
139: *
140: * .. Parameters ..
141: DOUBLE PRECISION ONE, ZERO
142: PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
143: * ..
144: * .. Local Scalars ..
145: LOGICAL APPLYLEFT
146: INTEGER I, LASTV, LASTC
147: * ..
148: * .. External Subroutines ..
149: EXTERNAL DGEMV, DGER
150: * ..
151: * .. External Functions ..
152: LOGICAL LSAME
153: INTEGER ILADLR, ILADLC
154: EXTERNAL LSAME, ILADLR, ILADLC
155: * ..
156: * .. Executable Statements ..
157: *
158: APPLYLEFT = LSAME( SIDE, 'L' )
159: LASTV = 0
160: LASTC = 0
161: IF( TAU.NE.ZERO ) THEN
162: ! Set up variables for scanning V. LASTV begins pointing to the end
163: ! of V.
164: IF( APPLYLEFT ) THEN
165: LASTV = M
166: ELSE
167: LASTV = N
168: END IF
169: IF( INCV.GT.0 ) THEN
170: I = 1 + (LASTV-1) * INCV
171: ELSE
172: I = 1
173: END IF
174: ! Look for the last non-zero row in V.
175: DO WHILE( LASTV.GT.0 .AND. V( I ).EQ.ZERO )
176: LASTV = LASTV - 1
177: I = I - INCV
178: END DO
179: IF( APPLYLEFT ) THEN
180: ! Scan for the last non-zero column in C(1:lastv,:).
181: LASTC = ILADLC(LASTV, N, C, LDC)
182: ELSE
183: ! Scan for the last non-zero row in C(:,1:lastv).
184: LASTC = ILADLR(M, LASTV, C, LDC)
185: END IF
186: END IF
187: ! Note that lastc.eq.0 renders the BLAS operations null; no special
188: ! case is needed at this level.
189: IF( APPLYLEFT ) THEN
190: *
191: * Form H * C
192: *
193: IF( LASTV.GT.0 ) THEN
194: *
1.8 bertrand 195: * w(1:lastc,1) := C(1:lastv,1:lastc)**T * v(1:lastv,1)
1.1 bertrand 196: *
197: CALL DGEMV( 'Transpose', LASTV, LASTC, ONE, C, LDC, V, INCV,
198: $ ZERO, WORK, 1 )
199: *
1.8 bertrand 200: * C(1:lastv,1:lastc) := C(...) - v(1:lastv,1) * w(1:lastc,1)**T
1.1 bertrand 201: *
202: CALL DGER( LASTV, LASTC, -TAU, V, INCV, WORK, 1, C, LDC )
203: END IF
204: ELSE
205: *
206: * Form C * H
207: *
208: IF( LASTV.GT.0 ) THEN
209: *
210: * w(1:lastc,1) := C(1:lastc,1:lastv) * v(1:lastv,1)
211: *
212: CALL DGEMV( 'No transpose', LASTC, LASTV, ONE, C, LDC,
213: $ V, INCV, ZERO, WORK, 1 )
214: *
1.8 bertrand 215: * C(1:lastc,1:lastv) := C(...) - w(1:lastc,1) * v(1:lastv,1)**T
1.1 bertrand 216: *
217: CALL DGER( LASTC, LASTV, -TAU, WORK, 1, V, INCV, C, LDC )
218: END IF
219: END IF
220: RETURN
221: *
222: * End of DLARF
223: *
224: END
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to dlarf.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / lapack / lapack