| *> \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 |
