|
|
*> \brief \b SLARF** =========== DOCUMENTATION ===========** Online html documentation available at * http://www.netlib.org/lapack/explore-html/ **> \htmlonly*> Download SLARF + dependencies *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slarf.f"> *> [TGZ]</a> *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slarf.f"> *> [ZIP]</a> *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slarf.f"> *> [TXT]</a>*> \endhtmlonly ** Definition:* ===========** SUBROUTINE SLARF( SIDE, M, N, V, INCV, TAU, C, LDC, WORK )* * .. Scalar Arguments ..* CHARACTER SIDE* INTEGER INCV, LDC, M, N* REAL TAU* ..* .. Array Arguments ..* REAL C( LDC, * ), V( * ), WORK( * )* ..* **> \par Purpose:* =============*>*> \verbatim*>*> 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.*> \endverbatim** Arguments:* ==========**> \param[in] SIDE*> \verbatim*> SIDE is CHARACTER*1*> = 'L': form H * C*> = 'R': form C * H*> \endverbatim*>*> \param[in] M*> \verbatim*> M is INTEGER*> The number of rows of the matrix C.*> \endverbatim*>*> \param[in] N*> \verbatim*> N is INTEGER*> The number of columns of the matrix C.*> \endverbatim*>*> \param[in] V*> \verbatim*> 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.*> \endverbatim*>*> \param[in] INCV*> \verbatim*> INCV is INTEGER*> The increment between elements of v. INCV <> 0.*> \endverbatim*>*> \param[in] TAU*> \verbatim*> TAU is REAL*> The value tau in the representation of H.*> \endverbatim*>*> \param[in,out] C*> \verbatim*> 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'.*> \endverbatim*>*> \param[in] LDC*> \verbatim*> LDC is INTEGER*> The leading dimension of the array C. LDC >= max(1,M).*> \endverbatim*>*> \param[out] WORK*> \verbatim*> WORK is REAL array, dimension*> (N) if SIDE = 'L'*> or (M) if SIDE = 'R'*> \endverbatim** Authors:* ========**> \author Univ. of Tennessee *> \author Univ. of California Berkeley *> \author Univ. of Colorado Denver *> \author NAG Ltd. **> \date November 2011**> \ingroup realOTHERauxiliary** ===================================================================== SUBROUTINE SLARF( SIDE, M, N, V, INCV, TAU, C, LDC, WORK )** -- LAPACK auxiliary routine (version 3.4.0) --* -- LAPACK is a software package provided by Univ. of Tennessee, --* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--* November 2011** .. Scalar Arguments .. CHARACTER SIDE INTEGER INCV, LDC, M, N REAL TAU* ..* .. Array Arguments .. REAL C( LDC, * ), V( * ), WORK( * )* ..** =====================================================================** .. Parameters .. REAL ONE, ZERO PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )* ..* .. Local Scalars .. LOGICAL APPLYLEFT INTEGER I, LASTV, LASTC* ..* .. External Subroutines .. EXTERNAL SGEMV, SGER* ..* .. External Functions .. LOGICAL LSAME INTEGER ILASLR, ILASLC EXTERNAL LSAME, ILASLR, ILASLC* ..* .. Executable Statements ..* APPLYLEFT = LSAME( SIDE, 'L' ) LASTV = 0 LASTC = 0 IF( TAU.NE.ZERO ) THEN! Set up variables for scanning V. LASTV begins pointing to the end! of V. IF( APPLYLEFT ) THEN LASTV = M ELSE LASTV = N END IF IF( INCV.GT.0 ) THEN I = 1 + (LASTV-1) * INCV ELSE I = 1 END IF! Look for the last non-zero row in V. DO WHILE( LASTV.GT.0 .AND. V( I ).EQ.ZERO ) LASTV = LASTV - 1 I = I - INCV END DO IF( APPLYLEFT ) THEN! Scan for the last non-zero column in C(1:lastv,:). LASTC = ILASLC(LASTV, N, C, LDC) ELSE! Scan for the last non-zero row in C(:,1:lastv). LASTC = ILASLR(M, LASTV, C, LDC) END IF END IF! Note that lastc.eq.0 renders the BLAS operations null; no special! case is needed at this level. IF( APPLYLEFT ) THEN** Form H * C* IF( LASTV.GT.0 ) THEN** w(1:lastc,1) := C(1:lastv,1:lastc)**T * v(1:lastv,1)* CALL SGEMV( 'Transpose', LASTV, LASTC, ONE, C, LDC, V, INCV, $ ZERO, WORK, 1 )** C(1:lastv,1:lastc) := C(...) - v(1:lastv,1) * w(1:lastc,1)**T* CALL SGER( LASTV, LASTC, -TAU, V, INCV, WORK, 1, C, LDC ) END IF ELSE** Form C * H* IF( LASTV.GT.0 ) THEN** w(1:lastc,1) := C(1:lastc,1:lastv) * v(1:lastv,1)* CALL SGEMV( 'No transpose', LASTC, LASTV, ONE, C, LDC, $ V, INCV, ZERO, WORK, 1 )** C(1:lastc,1:lastv) := C(...) - w(1:lastc,1) * v(1:lastv,1)**T* CALL SGER( LASTC, LASTV, -TAU, WORK, 1, V, INCV, C, LDC ) END IF END IF RETURN** End of SLARF* END
|
