LAPACK 3.11.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ slarf()

subroutine slarf ( character  SIDE,
integer  M,
integer  N,
real, dimension( * )  V,
integer  INCV,
real  TAU,
real, dimension( ldc, * )  C,
integer  LDC,
real, dimension( * )  WORK 
)

SLARF applies an elementary reflector to a general rectangular matrix.

Download SLARF + dependencies [TGZ] [ZIP] [TXT]

Purpose:
 SLARF applies a real elementary reflector H to a real m by n matrix
 C, from either the left or the right. H is represented in the form

       H = I - tau * v * v**T

 where tau is a real scalar and v is a real vector.

 If tau = 0, then H is taken to be the unit matrix.
Parameters
[in]SIDE
          SIDE is CHARACTER*1
          = 'L': form  H * C
          = 'R': form  C * H
[in]M
          M is INTEGER
          The number of rows of the matrix C.
[in]N
          N is INTEGER
          The number of columns of the matrix C.
[in]V
          V is REAL array, dimension
                     (1 + (M-1)*abs(INCV)) if SIDE = 'L'
                  or (1 + (N-1)*abs(INCV)) if SIDE = 'R'
          The vector v in the representation of H. V is not used if
          TAU = 0.
[in]INCV
          INCV is INTEGER
          The increment between elements of v. INCV <> 0.
[in]TAU
          TAU is REAL
          The value tau in the representation of H.
[in,out]C
          C is REAL array, dimension (LDC,N)
          On entry, the m by n matrix C.
          On exit, C is overwritten by the matrix H * C if SIDE = 'L',
          or C * H if SIDE = 'R'.
[in]LDC
          LDC is INTEGER
          The leading dimension of the array C. LDC >= max(1,M).
[out]WORK
          WORK is REAL array, dimension
                         (N) if SIDE = 'L'
                      or (M) if SIDE = 'R'
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

Definition at line 123 of file slarf.f.

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*
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:53
integer function ilaslr(M, N, A, LDA)
ILASLR scans a matrix for its last non-zero row.
Definition: ilaslr.f:78
integer function ilaslc(M, N, A, LDA)
ILASLC scans a matrix for its last non-zero column.
Definition: ilaslc.f:78
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
Here is the call graph for this function:
Here is the caller graph for this function: