LAPACK 3.11.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
slarf.f
Go to the documentation of this file.
1*> \brief \b SLARF 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 SLARF + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slarf.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slarf.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slarf.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18* Definition:
19* ===========
20*
21* SUBROUTINE SLARF( SIDE, M, N, V, INCV, TAU, C, LDC, WORK )
22*
23* .. Scalar Arguments ..
24* CHARACTER SIDE
25* INTEGER INCV, LDC, M, N
26* REAL TAU
27* ..
28* .. Array Arguments ..
29* REAL C( LDC, * ), V( * ), WORK( * )
30* ..
31*
32*
33*> \par Purpose:
34* =============
35*>
36*> \verbatim
37*>
38*> SLARF 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 REAL 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 REAL
88*> The value tau in the representation of H.
89*> \endverbatim
90*>
91*> \param[in,out] C
92*> \verbatim
93*> C is REAL 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 REAL 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*> \ingroup realOTHERauxiliary
121*
122* =====================================================================
123 SUBROUTINE slarf( SIDE, M, N, V, INCV, TAU, C, LDC, WORK )
124*
125* -- LAPACK auxiliary routine --
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 REAL TAU
133* ..
134* .. Array Arguments ..
135 REAL C( LDC, * ), V( * ), WORK( * )
136* ..
137*
138* =====================================================================
139*
140* .. Parameters ..
141 REAL ONE, ZERO
142 parameter( one = 1.0e+0, zero = 0.0e+0 )
143* ..
144* .. Local Scalars ..
145 LOGICAL APPLYLEFT
146 INTEGER I, LASTV, LASTC
147* ..
148* .. External Subroutines ..
149 EXTERNAL sgemv, sger
150* ..
151* .. External Functions ..
152 LOGICAL LSAME
153 INTEGER ILASLR, ILASLC
154 EXTERNAL lsame, ilaslr, ilaslc
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 = ilaslc(lastv, n, c, ldc)
182 ELSE
183! Scan for the last non-zero row in C(:,1:lastv).
184 lastc = ilaslr(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*
195* w(1:lastc,1) := C(1:lastv,1:lastc)**T * v(1:lastv,1)
196*
197 CALL sgemv( 'Transpose', lastv, lastc, one, c, ldc, v, incv,
198 $ zero, work, 1 )
199*
200* C(1:lastv,1:lastc) := C(...) - v(1:lastv,1) * w(1:lastc,1)**T
201*
202 CALL sger( 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 sgemv( 'No transpose', lastc, lastv, one, c, ldc,
213 $ v, incv, zero, work, 1 )
214*
215* C(1:lastc,1:lastv) := C(...) - w(1:lastc,1) * v(1:lastv,1)**T
216*
217 CALL sger( lastc, lastv, -tau, work, 1, v, incv, c, ldc )
218 END IF
219 END IF
220 RETURN
221*
222* End of SLARF
223*
224 END
subroutine slarf(SIDE, M, N, V, INCV, TAU, C, LDC, WORK)
SLARF applies an elementary reflector to a general rectangular matrix.
Definition: slarf.f:124
subroutine sger(M, N, ALPHA, X, INCX, Y, INCY, A, LDA)
SGER
Definition: sger.f:130
subroutine sgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
SGEMV
Definition: sgemv.f:156