1*> \brief \b ZLARF 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 ZLARF + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zlarf.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zlarf.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zlarf.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18*  Definition:
19*  ===========
20*
21*       SUBROUTINE ZLARF( SIDE, M, N, V, INCV, TAU, C, LDC, WORK )
22*
23*       .. Scalar Arguments ..
24*       CHARACTER          SIDE
25*       INTEGER            INCV, LDC, M, N
26*       COMPLEX*16         TAU
27*       ..
28*       .. Array Arguments ..
29*       COMPLEX*16         C( LDC, * ), V( * ), WORK( * )
30*       ..
31*
32*
33*> \par Purpose:
34*  =============
35*>
36*> \verbatim
37*>
38*> ZLARF applies a complex elementary reflector H to a complex M-by-N
39*> matrix C, from either the left or the right. H is represented in the
40*> form
41*>
42*>       H = I - tau * v * v**H
43*>
44*> where tau is a complex scalar and v is a complex vector.
45*>
46*> If tau = 0, then H is taken to be the unit matrix.
47*>
48*> To apply H**H, supply conjg(tau) instead
49*> tau.
50*> \endverbatim
51*
52*  Arguments:
53*  ==========
54*
55*> \param[in] SIDE
56*> \verbatim
57*>          SIDE is CHARACTER*1
58*>          = 'L': form  H * C
59*>          = 'R': form  C * H
60*> \endverbatim
61*>
62*> \param[in] M
63*> \verbatim
64*>          M is INTEGER
65*>          The number of rows of the matrix C.
66*> \endverbatim
67*>
68*> \param[in] N
69*> \verbatim
70*>          N is INTEGER
71*>          The number of columns of the matrix C.
72*> \endverbatim
73*>
74*> \param[in] V
75*> \verbatim
76*>          V is COMPLEX*16 array, dimension
77*>                     (1 + (M-1)*abs(INCV)) if SIDE = 'L'
78*>                  or (1 + (N-1)*abs(INCV)) if SIDE = 'R'
79*>          The vector v in the representation of H. V is not used if
80*>          TAU = 0.
81*> \endverbatim
82*>
83*> \param[in] INCV
84*> \verbatim
85*>          INCV is INTEGER
86*>          The increment between elements of v. INCV <> 0.
87*> \endverbatim
88*>
89*> \param[in] TAU
90*> \verbatim
91*>          TAU is COMPLEX*16
92*>          The value tau in the representation of H.
93*> \endverbatim
94*>
95*> \param[in,out] C
96*> \verbatim
97*>          C is COMPLEX*16 array, dimension (LDC,N)
98*>          On entry, the M-by-N matrix C.
99*>          On exit, C is overwritten by the matrix H * C if SIDE = 'L',
100*>          or C * H if SIDE = 'R'.
101*> \endverbatim
102*>
103*> \param[in] LDC
104*> \verbatim
105*>          LDC is INTEGER
106*>          The leading dimension of the array C. LDC >= max(1,M).
107*> \endverbatim
108*>
109*> \param[out] WORK
110*> \verbatim
111*>          WORK is COMPLEX*16 array, dimension
112*>                         (N) if SIDE = 'L'
113*>                      or (M) if SIDE = 'R'
114*> \endverbatim
115*
116*  Authors:
117*  ========
118*
119*> \author Univ. of Tennessee
120*> \author Univ. of California Berkeley
121*> \author Univ. of Colorado Denver
122*> \author NAG Ltd.
123*
124*> \ingroup complex16OTHERauxiliary
125*
126*  =====================================================================
127      SUBROUTINE ZLARF( SIDE, M, N, V, INCV, TAU, C, LDC, WORK )
128*
129*  -- LAPACK auxiliary routine --
130*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
131*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
132*
133*     .. Scalar Arguments ..
134      CHARACTER          SIDE
135      INTEGER            INCV, LDC, M, N
136      COMPLEX*16         TAU
137*     ..
138*     .. Array Arguments ..
139      COMPLEX*16         C( LDC, * ), V( * ), WORK( * )
140*     ..
141*
142*  =====================================================================
143*
144*     .. Parameters ..
145      COMPLEX*16         ONE, ZERO
146      PARAMETER          ( ONE = ( 1.0D+0, 0.0D+0 ),
147     $                   ZERO = ( 0.0D+0, 0.0D+0 ) )
148*     ..
149*     .. Local Scalars ..
150      LOGICAL            APPLYLEFT
151      INTEGER            I, LASTV, LASTC
152*     ..
153*     .. External Subroutines ..
154      EXTERNAL           ZGEMV, ZGERC
155*     ..
156*     .. External Functions ..
157      LOGICAL            LSAME
158      INTEGER            ILAZLR, ILAZLC
159      EXTERNAL           LSAME, ILAZLR, ILAZLC
160*     ..
161*     .. Executable Statements ..
162*
163      APPLYLEFT = LSAME( SIDE, 'L' )
164      LASTV = 0
165      LASTC = 0
166      IF( TAU.NE.ZERO ) THEN
167*     Set up variables for scanning V.  LASTV begins pointing to the end
168*     of V.
169         IF( APPLYLEFT ) THEN
170            LASTV = M
171         ELSE
172            LASTV = N
173         END IF
174         IF( INCV.GT.0 ) THEN
175            I = 1 + (LASTV-1) * INCV
176         ELSE
177            I = 1
178         END IF
179*     Look for the last non-zero row in V.
180         DO WHILE( LASTV.GT.0 .AND. V( I ).EQ.ZERO )
181            LASTV = LASTV - 1
182            I = I - INCV
183         END DO
184         IF( APPLYLEFT ) THEN
185*     Scan for the last non-zero column in C(1:lastv,:).
186            LASTC = ILAZLC(LASTV, N, C, LDC)
187         ELSE
188*     Scan for the last non-zero row in C(:,1:lastv).
189            LASTC = ILAZLR(M, LASTV, C, LDC)
190         END IF
191      END IF
192*     Note that lastc.eq.0 renders the BLAS operations null; no special
193*     case is needed at this level.
194      IF( APPLYLEFT ) THEN
195*
196*        Form  H * C
197*
198         IF( LASTV.GT.0 ) THEN
199*
200*           w(1:lastc,1) := C(1:lastv,1:lastc)**H * v(1:lastv,1)
201*
202            CALL ZGEMV( 'Conjugate transpose', LASTV, LASTC, ONE,
203     $           C, LDC, V, INCV, ZERO, WORK, 1 )
204*
205*           C(1:lastv,1:lastc) := C(...) - v(1:lastv,1) * w(1:lastc,1)**H
206*
207            CALL ZGERC( LASTV, LASTC, -TAU, V, INCV, WORK, 1, C, LDC )
208         END IF
209      ELSE
210*
211*        Form  C * H
212*
213         IF( LASTV.GT.0 ) THEN
214*
215*           w(1:lastc,1) := C(1:lastc,1:lastv) * v(1:lastv,1)
216*
217            CALL ZGEMV( 'No transpose', LASTC, LASTV, ONE, C, LDC,
218     $           V, INCV, ZERO, WORK, 1 )
219*
220*           C(1:lastc,1:lastv) := C(...) - w(1:lastc,1) * v(1:lastv,1)**H
221*
222            CALL ZGERC( LASTC, LASTV, -TAU, WORK, 1, V, INCV, C, LDC )
223         END IF
224      END IF
225      RETURN
226*
227*     End of ZLARF
228*
229      END
230