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

◆ dlarf1l()

subroutine dlarf1l ( character side,
integer m,
integer n,
double precision, dimension( * ) v,
integer incv,
double precision tau,
double precision, dimension( ldc, * ) c,
integer ldc,
double precision, dimension( * ) work )

DLARF1L applies an elementary reflector to a general rectangular

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

Purpose:
!>
!> DLARF1L 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 DOUBLE PRECISION 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 DOUBLE PRECISION
!>          The value tau in the representation of H.
!>
[in,out]C
!>          C is DOUBLE PRECISION 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 DOUBLE PRECISION 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 dlarf1l.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 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, FIRSTV, 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 firstv = 1
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 i = 1
170! Look for the last non-zero row in V.
171 DO WHILE( lastv.GT.firstv .AND. v( i ).EQ.zero )
172 firstv = firstv + 1
173 i = i + incv
174 END DO
175 IF( applyleft ) THEN
176! Scan for the last non-zero column in C(1:lastv,:).
177 lastc = iladlc(lastv, n, c, ldc)
178 ELSE
179! Scan for the last non-zero row in C(:,1:lastv).
180 lastc = iladlr(m, lastv, c, ldc)
181 END IF
182 END IF
183 IF( lastc.EQ.0 ) THEN
184 RETURN
185 END IF
186 IF( applyleft ) THEN
187*
188* Form H * C
189*
190 IF( lastv.GT.0 ) THEN
191 ! Check if m = 1. This means v = 1, So we just need to compute
192 ! C := HC = (1-\tau)C.
193 IF( lastv.EQ.firstv ) THEN
194 CALL dscal(lastc, one - tau, c( firstv, 1), ldc)
195 ELSE
196*
197* w(1:lastc,1) := C(1:lastv,1:lastc)**T * v(1:lastv,1)
198*
199 ! w(1:lastc,1) := C(1:lastv-1,1:lastc)**T * v(1:lastv-1,1)
200 CALL dgemv( 'Transpose', lastv-firstv, lastc, one,
201 $ c(firstv,1), ldc, v(i), incv, zero,
202 $ work, 1)
203 ! w(1:lastc,1) += C(lastv,1:lastc)**T * v(lastv,1) = C(lastv,1:lastc)**T
204 CALL daxpy(lastc, one, c(lastv,1), ldc, work, 1)
205*
206* C(1:lastv,1:lastc) := C(...) - tau * v(1:lastv,1) * w(1:lastc,1)**T
207*
208 ! C(lastv, 1:lastc) := C(...) - tau * v(lastv,1) * w(1:lastc,1)**T
209 ! = C(...) - tau * w(1:lastc,1)**T
210 CALL daxpy(lastc, -tau, work, 1, c(lastv,1), ldc)
211 ! C(1:lastv-1,1:lastc) := C(...) - tau * v(1:lastv-1,1)*w(1:lastc,1)**T
212 CALL dger(lastv-firstv, lastc, -tau, v(i), incv,
213 $ work, 1, c(firstv,1), ldc)
214 END IF
215 END IF
216 ELSE
217*
218* Form C * H
219*
220 IF( lastv.GT.0 ) THEN
221 ! Check if n = 1. This means v = 1, so we just need to compute
222 ! C := CH = C(1-\tau).
223 IF( lastv.EQ.firstv ) THEN
224 CALL dscal(lastc, one - tau, c, 1)
225 ELSE
226*
227* w(1:lastc,1) := C(1:lastc,1:lastv) * v(1:lastv,1)
228*
229 ! w(1:lastc,1) := C(1:lastc,1:lastv-1) * v(1:lastv-1,1)
230 CALL dgemv( 'No transpose', lastc, lastv-firstv,
231 $ one, c(1,firstv), ldc, v(i), incv, zero, work, 1 )
232 ! w(1:lastc,1) += C(1:lastc,lastv) * v(lastv,1) = C(1:lastc,lastv)
233 CALL daxpy(lastc, one, c(1,lastv), 1, work, 1)
234*
235* C(1:lastc,1:lastv) := C(...) - tau * w(1:lastc,1) * v(1:lastv,1)**T
236*
237 ! C(1:lastc,lastv) := C(...) - tau * w(1:lastc,1) * v(lastv,1)**T
238 ! = C(...) - tau * w(1:lastc,1)
239 CALL daxpy(lastc, -tau, work, 1, c(1,lastv), 1)
240 ! C(1:lastc,1:lastv-1) := C(...) - tau * w(1:lastc,1) * v(1:lastv-1)**T
241 CALL dger( lastc, lastv-firstv, -tau, work, 1, v(i),
242 $ incv, c(1,firstv), ldc )
243 END IF
244 END IF
245 END IF
246 RETURN
247*
248* End of DLARF1L
249*
daxpy
subroutine daxpy(n, da, dx, incx, dy, incy)
DAXPY
Definition daxpy.f:89
dgemv
subroutine dgemv(trans, m, n, alpha, a, lda, x, incx, beta, y, incy)
DGEMV
Definition dgemv.f:158
dger
subroutine dger(m, n, alpha, x, incx, y, incy, a, lda)
DGER
Definition dger.f:130
iladlc
integer function iladlc(m, n, a, lda)
ILADLC scans a matrix for its last non-zero column.
Definition iladlc.f:76
iladlr
integer function iladlr(m, n, a, lda)
ILADLR scans a matrix for its last non-zero row.
Definition iladlr.f:76
lsame
logical function lsame(ca, cb)
LSAME
Definition lsame.f:48
dscal
subroutine dscal(n, da, dx, incx)
DSCAL
Definition dscal.f:79
Here is the call graph for this function:
Here is the caller graph for this function: