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
225