xref: /aosp_15_r20/external/eigen/lapack/zlarfb.f (revision bf2c37156dfe67e5dfebd6d394bad8b2ab5804d4)
1*bf2c3715SXin Li*> \brief \b ZLARFB
2*bf2c3715SXin Li*
3*bf2c3715SXin Li*  =========== DOCUMENTATION ===========
4*bf2c3715SXin Li*
5*bf2c3715SXin Li* Online html documentation available at
6*bf2c3715SXin Li*            http://www.netlib.org/lapack/explore-html/
7*bf2c3715SXin Li*
8*bf2c3715SXin Li*> \htmlonly
9*bf2c3715SXin Li*> Download ZLARFB + dependencies
10*bf2c3715SXin Li*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zlarfb.f">
11*bf2c3715SXin Li*> [TGZ]</a>
12*bf2c3715SXin Li*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zlarfb.f">
13*bf2c3715SXin Li*> [ZIP]</a>
14*bf2c3715SXin Li*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zlarfb.f">
15*bf2c3715SXin Li*> [TXT]</a>
16*bf2c3715SXin Li*> \endhtmlonly
17*bf2c3715SXin Li*
18*bf2c3715SXin Li*  Definition:
19*bf2c3715SXin Li*  ===========
20*bf2c3715SXin Li*
21*bf2c3715SXin Li*       SUBROUTINE ZLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV,
22*bf2c3715SXin Li*                          T, LDT, C, LDC, WORK, LDWORK )
23*bf2c3715SXin Li*
24*bf2c3715SXin Li*       .. Scalar Arguments ..
25*bf2c3715SXin Li*       CHARACTER          DIRECT, SIDE, STOREV, TRANS
26*bf2c3715SXin Li*       INTEGER            K, LDC, LDT, LDV, LDWORK, M, N
27*bf2c3715SXin Li*       ..
28*bf2c3715SXin Li*       .. Array Arguments ..
29*bf2c3715SXin Li*       COMPLEX*16         C( LDC, * ), T( LDT, * ), V( LDV, * ),
30*bf2c3715SXin Li*      $                   WORK( LDWORK, * )
31*bf2c3715SXin Li*       ..
32*bf2c3715SXin Li*
33*bf2c3715SXin Li*
34*bf2c3715SXin Li*> \par Purpose:
35*bf2c3715SXin Li*  =============
36*bf2c3715SXin Li*>
37*bf2c3715SXin Li*> \verbatim
38*bf2c3715SXin Li*>
39*bf2c3715SXin Li*> ZLARFB applies a complex block reflector H or its transpose H**H to a
40*bf2c3715SXin Li*> complex M-by-N matrix C, from either the left or the right.
41*bf2c3715SXin Li*> \endverbatim
42*bf2c3715SXin Li*
43*bf2c3715SXin Li*  Arguments:
44*bf2c3715SXin Li*  ==========
45*bf2c3715SXin Li*
46*bf2c3715SXin Li*> \param[in] SIDE
47*bf2c3715SXin Li*> \verbatim
48*bf2c3715SXin Li*>          SIDE is CHARACTER*1
49*bf2c3715SXin Li*>          = 'L': apply H or H**H from the Left
50*bf2c3715SXin Li*>          = 'R': apply H or H**H from the Right
51*bf2c3715SXin Li*> \endverbatim
52*bf2c3715SXin Li*>
53*bf2c3715SXin Li*> \param[in] TRANS
54*bf2c3715SXin Li*> \verbatim
55*bf2c3715SXin Li*>          TRANS is CHARACTER*1
56*bf2c3715SXin Li*>          = 'N': apply H (No transpose)
57*bf2c3715SXin Li*>          = 'C': apply H**H (Conjugate transpose)
58*bf2c3715SXin Li*> \endverbatim
59*bf2c3715SXin Li*>
60*bf2c3715SXin Li*> \param[in] DIRECT
61*bf2c3715SXin Li*> \verbatim
62*bf2c3715SXin Li*>          DIRECT is CHARACTER*1
63*bf2c3715SXin Li*>          Indicates how H is formed from a product of elementary
64*bf2c3715SXin Li*>          reflectors
65*bf2c3715SXin Li*>          = 'F': H = H(1) H(2) . . . H(k) (Forward)
66*bf2c3715SXin Li*>          = 'B': H = H(k) . . . H(2) H(1) (Backward)
67*bf2c3715SXin Li*> \endverbatim
68*bf2c3715SXin Li*>
69*bf2c3715SXin Li*> \param[in] STOREV
70*bf2c3715SXin Li*> \verbatim
71*bf2c3715SXin Li*>          STOREV is CHARACTER*1
72*bf2c3715SXin Li*>          Indicates how the vectors which define the elementary
73*bf2c3715SXin Li*>          reflectors are stored:
74*bf2c3715SXin Li*>          = 'C': Columnwise
75*bf2c3715SXin Li*>          = 'R': Rowwise
76*bf2c3715SXin Li*> \endverbatim
77*bf2c3715SXin Li*>
78*bf2c3715SXin Li*> \param[in] M
79*bf2c3715SXin Li*> \verbatim
80*bf2c3715SXin Li*>          M is INTEGER
81*bf2c3715SXin Li*>          The number of rows of the matrix C.
82*bf2c3715SXin Li*> \endverbatim
83*bf2c3715SXin Li*>
84*bf2c3715SXin Li*> \param[in] N
85*bf2c3715SXin Li*> \verbatim
86*bf2c3715SXin Li*>          N is INTEGER
87*bf2c3715SXin Li*>          The number of columns of the matrix C.
88*bf2c3715SXin Li*> \endverbatim
89*bf2c3715SXin Li*>
90*bf2c3715SXin Li*> \param[in] K
91*bf2c3715SXin Li*> \verbatim
92*bf2c3715SXin Li*>          K is INTEGER
93*bf2c3715SXin Li*>          The order of the matrix T (= the number of elementary
94*bf2c3715SXin Li*>          reflectors whose product defines the block reflector).
95*bf2c3715SXin Li*> \endverbatim
96*bf2c3715SXin Li*>
97*bf2c3715SXin Li*> \param[in] V
98*bf2c3715SXin Li*> \verbatim
99*bf2c3715SXin Li*>          V is COMPLEX*16 array, dimension
100*bf2c3715SXin Li*>                                (LDV,K) if STOREV = 'C'
101*bf2c3715SXin Li*>                                (LDV,M) if STOREV = 'R' and SIDE = 'L'
102*bf2c3715SXin Li*>                                (LDV,N) if STOREV = 'R' and SIDE = 'R'
103*bf2c3715SXin Li*>          See Further Details.
104*bf2c3715SXin Li*> \endverbatim
105*bf2c3715SXin Li*>
106*bf2c3715SXin Li*> \param[in] LDV
107*bf2c3715SXin Li*> \verbatim
108*bf2c3715SXin Li*>          LDV is INTEGER
109*bf2c3715SXin Li*>          The leading dimension of the array V.
110*bf2c3715SXin Li*>          If STOREV = 'C' and SIDE = 'L', LDV >= max(1,M);
111*bf2c3715SXin Li*>          if STOREV = 'C' and SIDE = 'R', LDV >= max(1,N);
112*bf2c3715SXin Li*>          if STOREV = 'R', LDV >= K.
113*bf2c3715SXin Li*> \endverbatim
114*bf2c3715SXin Li*>
115*bf2c3715SXin Li*> \param[in] T
116*bf2c3715SXin Li*> \verbatim
117*bf2c3715SXin Li*>          T is COMPLEX*16 array, dimension (LDT,K)
118*bf2c3715SXin Li*>          The triangular K-by-K matrix T in the representation of the
119*bf2c3715SXin Li*>          block reflector.
120*bf2c3715SXin Li*> \endverbatim
121*bf2c3715SXin Li*>
122*bf2c3715SXin Li*> \param[in] LDT
123*bf2c3715SXin Li*> \verbatim
124*bf2c3715SXin Li*>          LDT is INTEGER
125*bf2c3715SXin Li*>          The leading dimension of the array T. LDT >= K.
126*bf2c3715SXin Li*> \endverbatim
127*bf2c3715SXin Li*>
128*bf2c3715SXin Li*> \param[in,out] C
129*bf2c3715SXin Li*> \verbatim
130*bf2c3715SXin Li*>          C is COMPLEX*16 array, dimension (LDC,N)
131*bf2c3715SXin Li*>          On entry, the M-by-N matrix C.
132*bf2c3715SXin Li*>          On exit, C is overwritten by H*C or H**H*C or C*H or C*H**H.
133*bf2c3715SXin Li*> \endverbatim
134*bf2c3715SXin Li*>
135*bf2c3715SXin Li*> \param[in] LDC
136*bf2c3715SXin Li*> \verbatim
137*bf2c3715SXin Li*>          LDC is INTEGER
138*bf2c3715SXin Li*>          The leading dimension of the array C. LDC >= max(1,M).
139*bf2c3715SXin Li*> \endverbatim
140*bf2c3715SXin Li*>
141*bf2c3715SXin Li*> \param[out] WORK
142*bf2c3715SXin Li*> \verbatim
143*bf2c3715SXin Li*>          WORK is COMPLEX*16 array, dimension (LDWORK,K)
144*bf2c3715SXin Li*> \endverbatim
145*bf2c3715SXin Li*>
146*bf2c3715SXin Li*> \param[in] LDWORK
147*bf2c3715SXin Li*> \verbatim
148*bf2c3715SXin Li*>          LDWORK is INTEGER
149*bf2c3715SXin Li*>          The leading dimension of the array WORK.
150*bf2c3715SXin Li*>          If SIDE = 'L', LDWORK >= max(1,N);
151*bf2c3715SXin Li*>          if SIDE = 'R', LDWORK >= max(1,M).
152*bf2c3715SXin Li*> \endverbatim
153*bf2c3715SXin Li*
154*bf2c3715SXin Li*  Authors:
155*bf2c3715SXin Li*  ========
156*bf2c3715SXin Li*
157*bf2c3715SXin Li*> \author Univ. of Tennessee
158*bf2c3715SXin Li*> \author Univ. of California Berkeley
159*bf2c3715SXin Li*> \author Univ. of Colorado Denver
160*bf2c3715SXin Li*> \author NAG Ltd.
161*bf2c3715SXin Li*
162*bf2c3715SXin Li*> \date November 2011
163*bf2c3715SXin Li*
164*bf2c3715SXin Li*> \ingroup complex16OTHERauxiliary
165*bf2c3715SXin Li*
166*bf2c3715SXin Li*> \par Further Details:
167*bf2c3715SXin Li*  =====================
168*bf2c3715SXin Li*>
169*bf2c3715SXin Li*> \verbatim
170*bf2c3715SXin Li*>
171*bf2c3715SXin Li*>  The shape of the matrix V and the storage of the vectors which define
172*bf2c3715SXin Li*>  the H(i) is best illustrated by the following example with n = 5 and
173*bf2c3715SXin Li*>  k = 3. The elements equal to 1 are not stored; the corresponding
174*bf2c3715SXin Li*>  array elements are modified but restored on exit. The rest of the
175*bf2c3715SXin Li*>  array is not used.
176*bf2c3715SXin Li*>
177*bf2c3715SXin Li*>  DIRECT = 'F' and STOREV = 'C':         DIRECT = 'F' and STOREV = 'R':
178*bf2c3715SXin Li*>
179*bf2c3715SXin Li*>               V = (  1       )                 V = (  1 v1 v1 v1 v1 )
180*bf2c3715SXin Li*>                   ( v1  1    )                     (     1 v2 v2 v2 )
181*bf2c3715SXin Li*>                   ( v1 v2  1 )                     (        1 v3 v3 )
182*bf2c3715SXin Li*>                   ( v1 v2 v3 )
183*bf2c3715SXin Li*>                   ( v1 v2 v3 )
184*bf2c3715SXin Li*>
185*bf2c3715SXin Li*>  DIRECT = 'B' and STOREV = 'C':         DIRECT = 'B' and STOREV = 'R':
186*bf2c3715SXin Li*>
187*bf2c3715SXin Li*>               V = ( v1 v2 v3 )                 V = ( v1 v1  1       )
188*bf2c3715SXin Li*>                   ( v1 v2 v3 )                     ( v2 v2 v2  1    )
189*bf2c3715SXin Li*>                   (  1 v2 v3 )                     ( v3 v3 v3 v3  1 )
190*bf2c3715SXin Li*>                   (     1 v3 )
191*bf2c3715SXin Li*>                   (        1 )
192*bf2c3715SXin Li*> \endverbatim
193*bf2c3715SXin Li*>
194*bf2c3715SXin Li*  =====================================================================
195*bf2c3715SXin Li      SUBROUTINE ZLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV,
196*bf2c3715SXin Li     $                   T, LDT, C, LDC, WORK, LDWORK )
197*bf2c3715SXin Li*
198*bf2c3715SXin Li*  -- LAPACK auxiliary routine (version 3.4.0) --
199*bf2c3715SXin Li*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
200*bf2c3715SXin Li*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
201*bf2c3715SXin Li*     November 2011
202*bf2c3715SXin Li*
203*bf2c3715SXin Li*     .. Scalar Arguments ..
204*bf2c3715SXin Li      CHARACTER          DIRECT, SIDE, STOREV, TRANS
205*bf2c3715SXin Li      INTEGER            K, LDC, LDT, LDV, LDWORK, M, N
206*bf2c3715SXin Li*     ..
207*bf2c3715SXin Li*     .. Array Arguments ..
208*bf2c3715SXin Li      COMPLEX*16         C( LDC, * ), T( LDT, * ), V( LDV, * ),
209*bf2c3715SXin Li     $                   WORK( LDWORK, * )
210*bf2c3715SXin Li*     ..
211*bf2c3715SXin Li*
212*bf2c3715SXin Li*  =====================================================================
213*bf2c3715SXin Li*
214*bf2c3715SXin Li*     .. Parameters ..
215*bf2c3715SXin Li      COMPLEX*16         ONE
216*bf2c3715SXin Li      PARAMETER          ( ONE = ( 1.0D+0, 0.0D+0 ) )
217*bf2c3715SXin Li*     ..
218*bf2c3715SXin Li*     .. Local Scalars ..
219*bf2c3715SXin Li      CHARACTER          TRANST
220*bf2c3715SXin Li      INTEGER            I, J, LASTV, LASTC
221*bf2c3715SXin Li*     ..
222*bf2c3715SXin Li*     .. External Functions ..
223*bf2c3715SXin Li      LOGICAL            LSAME
224*bf2c3715SXin Li      INTEGER            ILAZLR, ILAZLC
225*bf2c3715SXin Li      EXTERNAL           LSAME, ILAZLR, ILAZLC
226*bf2c3715SXin Li*     ..
227*bf2c3715SXin Li*     .. External Subroutines ..
228*bf2c3715SXin Li      EXTERNAL           ZCOPY, ZGEMM, ZLACGV, ZTRMM
229*bf2c3715SXin Li*     ..
230*bf2c3715SXin Li*     .. Intrinsic Functions ..
231*bf2c3715SXin Li      INTRINSIC          DCONJG
232*bf2c3715SXin Li*     ..
233*bf2c3715SXin Li*     .. Executable Statements ..
234*bf2c3715SXin Li*
235*bf2c3715SXin Li*     Quick return if possible
236*bf2c3715SXin Li*
237*bf2c3715SXin Li      IF( M.LE.0 .OR. N.LE.0 )
238*bf2c3715SXin Li     $   RETURN
239*bf2c3715SXin Li*
240*bf2c3715SXin Li      IF( LSAME( TRANS, 'N' ) ) THEN
241*bf2c3715SXin Li         TRANST = 'C'
242*bf2c3715SXin Li      ELSE
243*bf2c3715SXin Li         TRANST = 'N'
244*bf2c3715SXin Li      END IF
245*bf2c3715SXin Li*
246*bf2c3715SXin Li      IF( LSAME( STOREV, 'C' ) ) THEN
247*bf2c3715SXin Li*
248*bf2c3715SXin Li         IF( LSAME( DIRECT, 'F' ) ) THEN
249*bf2c3715SXin Li*
250*bf2c3715SXin Li*           Let  V =  ( V1 )    (first K rows)
251*bf2c3715SXin Li*                     ( V2 )
252*bf2c3715SXin Li*           where  V1  is unit lower triangular.
253*bf2c3715SXin Li*
254*bf2c3715SXin Li            IF( LSAME( SIDE, 'L' ) ) THEN
255*bf2c3715SXin Li*
256*bf2c3715SXin Li*              Form  H * C  or  H**H * C  where  C = ( C1 )
257*bf2c3715SXin Li*                                                    ( C2 )
258*bf2c3715SXin Li*
259*bf2c3715SXin Li               LASTV = MAX( K, ILAZLR( M, K, V, LDV ) )
260*bf2c3715SXin Li               LASTC = ILAZLC( LASTV, N, C, LDC )
261*bf2c3715SXin Li*
262*bf2c3715SXin Li*              W := C**H * V  =  (C1**H * V1 + C2**H * V2)  (stored in WORK)
263*bf2c3715SXin Li*
264*bf2c3715SXin Li*              W := C1**H
265*bf2c3715SXin Li*
266*bf2c3715SXin Li               DO 10 J = 1, K
267*bf2c3715SXin Li                  CALL ZCOPY( LASTC, C( J, 1 ), LDC, WORK( 1, J ), 1 )
268*bf2c3715SXin Li                  CALL ZLACGV( LASTC, WORK( 1, J ), 1 )
269*bf2c3715SXin Li   10          CONTINUE
270*bf2c3715SXin Li*
271*bf2c3715SXin Li*              W := W * V1
272*bf2c3715SXin Li*
273*bf2c3715SXin Li               CALL ZTRMM( 'Right', 'Lower', 'No transpose', 'Unit',
274*bf2c3715SXin Li     $              LASTC, K, ONE, V, LDV, WORK, LDWORK )
275*bf2c3715SXin Li               IF( LASTV.GT.K ) THEN
276*bf2c3715SXin Li*
277*bf2c3715SXin Li*                 W := W + C2**H *V2
278*bf2c3715SXin Li*
279*bf2c3715SXin Li                  CALL ZGEMM( 'Conjugate transpose', 'No transpose',
280*bf2c3715SXin Li     $                 LASTC, K, LASTV-K, ONE, C( K+1, 1 ), LDC,
281*bf2c3715SXin Li     $                 V( K+1, 1 ), LDV, ONE, WORK, LDWORK )
282*bf2c3715SXin Li               END IF
283*bf2c3715SXin Li*
284*bf2c3715SXin Li*              W := W * T**H  or  W * T
285*bf2c3715SXin Li*
286*bf2c3715SXin Li               CALL ZTRMM( 'Right', 'Upper', TRANST, 'Non-unit',
287*bf2c3715SXin Li     $              LASTC, K, ONE, T, LDT, WORK, LDWORK )
288*bf2c3715SXin Li*
289*bf2c3715SXin Li*              C := C - V * W**H
290*bf2c3715SXin Li*
291*bf2c3715SXin Li               IF( M.GT.K ) THEN
292*bf2c3715SXin Li*
293*bf2c3715SXin Li*                 C2 := C2 - V2 * W**H
294*bf2c3715SXin Li*
295*bf2c3715SXin Li                  CALL ZGEMM( 'No transpose', 'Conjugate transpose',
296*bf2c3715SXin Li     $                 LASTV-K, LASTC, K,
297*bf2c3715SXin Li     $                 -ONE, V( K+1, 1 ), LDV, WORK, LDWORK,
298*bf2c3715SXin Li     $                 ONE, C( K+1, 1 ), LDC )
299*bf2c3715SXin Li               END IF
300*bf2c3715SXin Li*
301*bf2c3715SXin Li*              W := W * V1**H
302*bf2c3715SXin Li*
303*bf2c3715SXin Li               CALL ZTRMM( 'Right', 'Lower', 'Conjugate transpose',
304*bf2c3715SXin Li     $              'Unit', LASTC, K, ONE, V, LDV, WORK, LDWORK )
305*bf2c3715SXin Li*
306*bf2c3715SXin Li*              C1 := C1 - W**H
307*bf2c3715SXin Li*
308*bf2c3715SXin Li               DO 30 J = 1, K
309*bf2c3715SXin Li                  DO 20 I = 1, LASTC
310*bf2c3715SXin Li                     C( J, I ) = C( J, I ) - DCONJG( WORK( I, J ) )
311*bf2c3715SXin Li   20             CONTINUE
312*bf2c3715SXin Li   30          CONTINUE
313*bf2c3715SXin Li*
314*bf2c3715SXin Li            ELSE IF( LSAME( SIDE, 'R' ) ) THEN
315*bf2c3715SXin Li*
316*bf2c3715SXin Li*              Form  C * H  or  C * H**H  where  C = ( C1  C2 )
317*bf2c3715SXin Li*
318*bf2c3715SXin Li               LASTV = MAX( K, ILAZLR( N, K, V, LDV ) )
319*bf2c3715SXin Li               LASTC = ILAZLR( M, LASTV, C, LDC )
320*bf2c3715SXin Li*
321*bf2c3715SXin Li*              W := C * V  =  (C1*V1 + C2*V2)  (stored in WORK)
322*bf2c3715SXin Li*
323*bf2c3715SXin Li*              W := C1
324*bf2c3715SXin Li*
325*bf2c3715SXin Li               DO 40 J = 1, K
326*bf2c3715SXin Li                  CALL ZCOPY( LASTC, C( 1, J ), 1, WORK( 1, J ), 1 )
327*bf2c3715SXin Li   40          CONTINUE
328*bf2c3715SXin Li*
329*bf2c3715SXin Li*              W := W * V1
330*bf2c3715SXin Li*
331*bf2c3715SXin Li               CALL ZTRMM( 'Right', 'Lower', 'No transpose', 'Unit',
332*bf2c3715SXin Li     $              LASTC, K, ONE, V, LDV, WORK, LDWORK )
333*bf2c3715SXin Li               IF( LASTV.GT.K ) THEN
334*bf2c3715SXin Li*
335*bf2c3715SXin Li*                 W := W + C2 * V2
336*bf2c3715SXin Li*
337*bf2c3715SXin Li                  CALL ZGEMM( 'No transpose', 'No transpose',
338*bf2c3715SXin Li     $                 LASTC, K, LASTV-K,
339*bf2c3715SXin Li     $                 ONE, C( 1, K+1 ), LDC, V( K+1, 1 ), LDV,
340*bf2c3715SXin Li     $                 ONE, WORK, LDWORK )
341*bf2c3715SXin Li               END IF
342*bf2c3715SXin Li*
343*bf2c3715SXin Li*              W := W * T  or  W * T**H
344*bf2c3715SXin Li*
345*bf2c3715SXin Li               CALL ZTRMM( 'Right', 'Upper', TRANS, 'Non-unit',
346*bf2c3715SXin Li     $              LASTC, K, ONE, T, LDT, WORK, LDWORK )
347*bf2c3715SXin Li*
348*bf2c3715SXin Li*              C := C - W * V**H
349*bf2c3715SXin Li*
350*bf2c3715SXin Li               IF( LASTV.GT.K ) THEN
351*bf2c3715SXin Li*
352*bf2c3715SXin Li*                 C2 := C2 - W * V2**H
353*bf2c3715SXin Li*
354*bf2c3715SXin Li                  CALL ZGEMM( 'No transpose', 'Conjugate transpose',
355*bf2c3715SXin Li     $                 LASTC, LASTV-K, K,
356*bf2c3715SXin Li     $                 -ONE, WORK, LDWORK, V( K+1, 1 ), LDV,
357*bf2c3715SXin Li     $                 ONE, C( 1, K+1 ), LDC )
358*bf2c3715SXin Li               END IF
359*bf2c3715SXin Li*
360*bf2c3715SXin Li*              W := W * V1**H
361*bf2c3715SXin Li*
362*bf2c3715SXin Li               CALL ZTRMM( 'Right', 'Lower', 'Conjugate transpose',
363*bf2c3715SXin Li     $              'Unit', LASTC, K, ONE, V, LDV, WORK, LDWORK )
364*bf2c3715SXin Li*
365*bf2c3715SXin Li*              C1 := C1 - W
366*bf2c3715SXin Li*
367*bf2c3715SXin Li               DO 60 J = 1, K
368*bf2c3715SXin Li                  DO 50 I = 1, LASTC
369*bf2c3715SXin Li                     C( I, J ) = C( I, J ) - WORK( I, J )
370*bf2c3715SXin Li   50             CONTINUE
371*bf2c3715SXin Li   60          CONTINUE
372*bf2c3715SXin Li            END IF
373*bf2c3715SXin Li*
374*bf2c3715SXin Li         ELSE
375*bf2c3715SXin Li*
376*bf2c3715SXin Li*           Let  V =  ( V1 )
377*bf2c3715SXin Li*                     ( V2 )    (last K rows)
378*bf2c3715SXin Li*           where  V2  is unit upper triangular.
379*bf2c3715SXin Li*
380*bf2c3715SXin Li            IF( LSAME( SIDE, 'L' ) ) THEN
381*bf2c3715SXin Li*
382*bf2c3715SXin Li*              Form  H * C  or  H**H * C  where  C = ( C1 )
383*bf2c3715SXin Li*                                                    ( C2 )
384*bf2c3715SXin Li*
385*bf2c3715SXin Li               LASTV = MAX( K, ILAZLR( M, K, V, LDV ) )
386*bf2c3715SXin Li               LASTC = ILAZLC( LASTV, N, C, LDC )
387*bf2c3715SXin Li*
388*bf2c3715SXin Li*              W := C**H * V  =  (C1**H * V1 + C2**H * V2)  (stored in WORK)
389*bf2c3715SXin Li*
390*bf2c3715SXin Li*              W := C2**H
391*bf2c3715SXin Li*
392*bf2c3715SXin Li               DO 70 J = 1, K
393*bf2c3715SXin Li                  CALL ZCOPY( LASTC, C( LASTV-K+J, 1 ), LDC,
394*bf2c3715SXin Li     $                 WORK( 1, J ), 1 )
395*bf2c3715SXin Li                  CALL ZLACGV( LASTC, WORK( 1, J ), 1 )
396*bf2c3715SXin Li   70          CONTINUE
397*bf2c3715SXin Li*
398*bf2c3715SXin Li*              W := W * V2
399*bf2c3715SXin Li*
400*bf2c3715SXin Li               CALL ZTRMM( 'Right', 'Upper', 'No transpose', 'Unit',
401*bf2c3715SXin Li     $              LASTC, K, ONE, V( LASTV-K+1, 1 ), LDV,
402*bf2c3715SXin Li     $              WORK, LDWORK )
403*bf2c3715SXin Li               IF( LASTV.GT.K ) THEN
404*bf2c3715SXin Li*
405*bf2c3715SXin Li*                 W := W + C1**H*V1
406*bf2c3715SXin Li*
407*bf2c3715SXin Li                  CALL ZGEMM( 'Conjugate transpose', 'No transpose',
408*bf2c3715SXin Li     $                 LASTC, K, LASTV-K,
409*bf2c3715SXin Li     $                 ONE, C, LDC, V, LDV,
410*bf2c3715SXin Li     $                 ONE, WORK, LDWORK )
411*bf2c3715SXin Li               END IF
412*bf2c3715SXin Li*
413*bf2c3715SXin Li*              W := W * T**H  or  W * T
414*bf2c3715SXin Li*
415*bf2c3715SXin Li               CALL ZTRMM( 'Right', 'Lower', TRANST, 'Non-unit',
416*bf2c3715SXin Li     $              LASTC, K, ONE, T, LDT, WORK, LDWORK )
417*bf2c3715SXin Li*
418*bf2c3715SXin Li*              C := C - V * W**H
419*bf2c3715SXin Li*
420*bf2c3715SXin Li               IF( LASTV.GT.K ) THEN
421*bf2c3715SXin Li*
422*bf2c3715SXin Li*                 C1 := C1 - V1 * W**H
423*bf2c3715SXin Li*
424*bf2c3715SXin Li                  CALL ZGEMM( 'No transpose', 'Conjugate transpose',
425*bf2c3715SXin Li     $                 LASTV-K, LASTC, K,
426*bf2c3715SXin Li     $                 -ONE, V, LDV, WORK, LDWORK,
427*bf2c3715SXin Li     $                 ONE, C, LDC )
428*bf2c3715SXin Li               END IF
429*bf2c3715SXin Li*
430*bf2c3715SXin Li*              W := W * V2**H
431*bf2c3715SXin Li*
432*bf2c3715SXin Li               CALL ZTRMM( 'Right', 'Upper', 'Conjugate transpose',
433*bf2c3715SXin Li     $              'Unit', LASTC, K, ONE, V( LASTV-K+1, 1 ), LDV,
434*bf2c3715SXin Li     $              WORK, LDWORK )
435*bf2c3715SXin Li*
436*bf2c3715SXin Li*              C2 := C2 - W**H
437*bf2c3715SXin Li*
438*bf2c3715SXin Li               DO 90 J = 1, K
439*bf2c3715SXin Li                  DO 80 I = 1, LASTC
440*bf2c3715SXin Li                     C( LASTV-K+J, I ) = C( LASTV-K+J, I ) -
441*bf2c3715SXin Li     $                               DCONJG( WORK( I, J ) )
442*bf2c3715SXin Li   80             CONTINUE
443*bf2c3715SXin Li   90          CONTINUE
444*bf2c3715SXin Li*
445*bf2c3715SXin Li            ELSE IF( LSAME( SIDE, 'R' ) ) THEN
446*bf2c3715SXin Li*
447*bf2c3715SXin Li*              Form  C * H  or  C * H**H  where  C = ( C1  C2 )
448*bf2c3715SXin Li*
449*bf2c3715SXin Li               LASTV = MAX( K, ILAZLR( N, K, V, LDV ) )
450*bf2c3715SXin Li               LASTC = ILAZLR( M, LASTV, C, LDC )
451*bf2c3715SXin Li*
452*bf2c3715SXin Li*              W := C * V  =  (C1*V1 + C2*V2)  (stored in WORK)
453*bf2c3715SXin Li*
454*bf2c3715SXin Li*              W := C2
455*bf2c3715SXin Li*
456*bf2c3715SXin Li               DO 100 J = 1, K
457*bf2c3715SXin Li                  CALL ZCOPY( LASTC, C( 1, LASTV-K+J ), 1,
458*bf2c3715SXin Li     $                 WORK( 1, J ), 1 )
459*bf2c3715SXin Li  100          CONTINUE
460*bf2c3715SXin Li*
461*bf2c3715SXin Li*              W := W * V2
462*bf2c3715SXin Li*
463*bf2c3715SXin Li               CALL ZTRMM( 'Right', 'Upper', 'No transpose', 'Unit',
464*bf2c3715SXin Li     $              LASTC, K, ONE, V( LASTV-K+1, 1 ), LDV,
465*bf2c3715SXin Li     $              WORK, LDWORK )
466*bf2c3715SXin Li               IF( LASTV.GT.K ) THEN
467*bf2c3715SXin Li*
468*bf2c3715SXin Li*                 W := W + C1 * V1
469*bf2c3715SXin Li*
470*bf2c3715SXin Li                  CALL ZGEMM( 'No transpose', 'No transpose',
471*bf2c3715SXin Li     $                 LASTC, K, LASTV-K,
472*bf2c3715SXin Li     $                 ONE, C, LDC, V, LDV, ONE, WORK, LDWORK )
473*bf2c3715SXin Li               END IF
474*bf2c3715SXin Li*
475*bf2c3715SXin Li*              W := W * T  or  W * T**H
476*bf2c3715SXin Li*
477*bf2c3715SXin Li               CALL ZTRMM( 'Right', 'Lower', TRANS, 'Non-unit',
478*bf2c3715SXin Li     $              LASTC, K, ONE, T, LDT, WORK, LDWORK )
479*bf2c3715SXin Li*
480*bf2c3715SXin Li*              C := C - W * V**H
481*bf2c3715SXin Li*
482*bf2c3715SXin Li               IF( LASTV.GT.K ) THEN
483*bf2c3715SXin Li*
484*bf2c3715SXin Li*                 C1 := C1 - W * V1**H
485*bf2c3715SXin Li*
486*bf2c3715SXin Li                  CALL ZGEMM( 'No transpose', 'Conjugate transpose',
487*bf2c3715SXin Li     $                 LASTC, LASTV-K, K, -ONE, WORK, LDWORK, V, LDV,
488*bf2c3715SXin Li     $                 ONE, C, LDC )
489*bf2c3715SXin Li               END IF
490*bf2c3715SXin Li*
491*bf2c3715SXin Li*              W := W * V2**H
492*bf2c3715SXin Li*
493*bf2c3715SXin Li               CALL ZTRMM( 'Right', 'Upper', 'Conjugate transpose',
494*bf2c3715SXin Li     $              'Unit', LASTC, K, ONE, V( LASTV-K+1, 1 ), LDV,
495*bf2c3715SXin Li     $              WORK, LDWORK )
496*bf2c3715SXin Li*
497*bf2c3715SXin Li*              C2 := C2 - W
498*bf2c3715SXin Li*
499*bf2c3715SXin Li               DO 120 J = 1, K
500*bf2c3715SXin Li                  DO 110 I = 1, LASTC
501*bf2c3715SXin Li                     C( I, LASTV-K+J ) = C( I, LASTV-K+J )
502*bf2c3715SXin Li     $                    - WORK( I, J )
503*bf2c3715SXin Li  110             CONTINUE
504*bf2c3715SXin Li  120          CONTINUE
505*bf2c3715SXin Li            END IF
506*bf2c3715SXin Li         END IF
507*bf2c3715SXin Li*
508*bf2c3715SXin Li      ELSE IF( LSAME( STOREV, 'R' ) ) THEN
509*bf2c3715SXin Li*
510*bf2c3715SXin Li         IF( LSAME( DIRECT, 'F' ) ) THEN
511*bf2c3715SXin Li*
512*bf2c3715SXin Li*           Let  V =  ( V1  V2 )    (V1: first K columns)
513*bf2c3715SXin Li*           where  V1  is unit upper triangular.
514*bf2c3715SXin Li*
515*bf2c3715SXin Li            IF( LSAME( SIDE, 'L' ) ) THEN
516*bf2c3715SXin Li*
517*bf2c3715SXin Li*              Form  H * C  or  H**H * C  where  C = ( C1 )
518*bf2c3715SXin Li*                                                    ( C2 )
519*bf2c3715SXin Li*
520*bf2c3715SXin Li               LASTV = MAX( K, ILAZLC( K, M, V, LDV ) )
521*bf2c3715SXin Li               LASTC = ILAZLC( LASTV, N, C, LDC )
522*bf2c3715SXin Li*
523*bf2c3715SXin Li*              W := C**H * V**H  =  (C1**H * V1**H + C2**H * V2**H) (stored in WORK)
524*bf2c3715SXin Li*
525*bf2c3715SXin Li*              W := C1**H
526*bf2c3715SXin Li*
527*bf2c3715SXin Li               DO 130 J = 1, K
528*bf2c3715SXin Li                  CALL ZCOPY( LASTC, C( J, 1 ), LDC, WORK( 1, J ), 1 )
529*bf2c3715SXin Li                  CALL ZLACGV( LASTC, WORK( 1, J ), 1 )
530*bf2c3715SXin Li  130          CONTINUE
531*bf2c3715SXin Li*
532*bf2c3715SXin Li*              W := W * V1**H
533*bf2c3715SXin Li*
534*bf2c3715SXin Li               CALL ZTRMM( 'Right', 'Upper', 'Conjugate transpose',
535*bf2c3715SXin Li     $                     'Unit', LASTC, K, ONE, V, LDV, WORK, LDWORK )
536*bf2c3715SXin Li               IF( LASTV.GT.K ) THEN
537*bf2c3715SXin Li*
538*bf2c3715SXin Li*                 W := W + C2**H*V2**H
539*bf2c3715SXin Li*
540*bf2c3715SXin Li                  CALL ZGEMM( 'Conjugate transpose',
541*bf2c3715SXin Li     $                 'Conjugate transpose', LASTC, K, LASTV-K,
542*bf2c3715SXin Li     $                 ONE, C( K+1, 1 ), LDC, V( 1, K+1 ), LDV,
543*bf2c3715SXin Li     $                 ONE, WORK, LDWORK )
544*bf2c3715SXin Li               END IF
545*bf2c3715SXin Li*
546*bf2c3715SXin Li*              W := W * T**H  or  W * T
547*bf2c3715SXin Li*
548*bf2c3715SXin Li               CALL ZTRMM( 'Right', 'Upper', TRANST, 'Non-unit',
549*bf2c3715SXin Li     $              LASTC, K, ONE, T, LDT, WORK, LDWORK )
550*bf2c3715SXin Li*
551*bf2c3715SXin Li*              C := C - V**H * W**H
552*bf2c3715SXin Li*
553*bf2c3715SXin Li               IF( LASTV.GT.K ) THEN
554*bf2c3715SXin Li*
555*bf2c3715SXin Li*                 C2 := C2 - V2**H * W**H
556*bf2c3715SXin Li*
557*bf2c3715SXin Li                  CALL ZGEMM( 'Conjugate transpose',
558*bf2c3715SXin Li     $                 'Conjugate transpose', LASTV-K, LASTC, K,
559*bf2c3715SXin Li     $                 -ONE, V( 1, K+1 ), LDV, WORK, LDWORK,
560*bf2c3715SXin Li     $                 ONE, C( K+1, 1 ), LDC )
561*bf2c3715SXin Li               END IF
562*bf2c3715SXin Li*
563*bf2c3715SXin Li*              W := W * V1
564*bf2c3715SXin Li*
565*bf2c3715SXin Li               CALL ZTRMM( 'Right', 'Upper', 'No transpose', 'Unit',
566*bf2c3715SXin Li     $              LASTC, K, ONE, V, LDV, WORK, LDWORK )
567*bf2c3715SXin Li*
568*bf2c3715SXin Li*              C1 := C1 - W**H
569*bf2c3715SXin Li*
570*bf2c3715SXin Li               DO 150 J = 1, K
571*bf2c3715SXin Li                  DO 140 I = 1, LASTC
572*bf2c3715SXin Li                     C( J, I ) = C( J, I ) - DCONJG( WORK( I, J ) )
573*bf2c3715SXin Li  140             CONTINUE
574*bf2c3715SXin Li  150          CONTINUE
575*bf2c3715SXin Li*
576*bf2c3715SXin Li            ELSE IF( LSAME( SIDE, 'R' ) ) THEN
577*bf2c3715SXin Li*
578*bf2c3715SXin Li*              Form  C * H  or  C * H**H  where  C = ( C1  C2 )
579*bf2c3715SXin Li*
580*bf2c3715SXin Li               LASTV = MAX( K, ILAZLC( K, N, V, LDV ) )
581*bf2c3715SXin Li               LASTC = ILAZLR( M, LASTV, C, LDC )
582*bf2c3715SXin Li*
583*bf2c3715SXin Li*              W := C * V**H  =  (C1*V1**H + C2*V2**H)  (stored in WORK)
584*bf2c3715SXin Li*
585*bf2c3715SXin Li*              W := C1
586*bf2c3715SXin Li*
587*bf2c3715SXin Li               DO 160 J = 1, K
588*bf2c3715SXin Li                  CALL ZCOPY( LASTC, C( 1, J ), 1, WORK( 1, J ), 1 )
589*bf2c3715SXin Li  160          CONTINUE
590*bf2c3715SXin Li*
591*bf2c3715SXin Li*              W := W * V1**H
592*bf2c3715SXin Li*
593*bf2c3715SXin Li               CALL ZTRMM( 'Right', 'Upper', 'Conjugate transpose',
594*bf2c3715SXin Li     $                     'Unit', LASTC, K, ONE, V, LDV, WORK, LDWORK )
595*bf2c3715SXin Li               IF( LASTV.GT.K ) THEN
596*bf2c3715SXin Li*
597*bf2c3715SXin Li*                 W := W + C2 * V2**H
598*bf2c3715SXin Li*
599*bf2c3715SXin Li                  CALL ZGEMM( 'No transpose', 'Conjugate transpose',
600*bf2c3715SXin Li     $                 LASTC, K, LASTV-K, ONE, C( 1, K+1 ), LDC,
601*bf2c3715SXin Li     $                 V( 1, K+1 ), LDV, ONE, WORK, LDWORK )
602*bf2c3715SXin Li               END IF
603*bf2c3715SXin Li*
604*bf2c3715SXin Li*              W := W * T  or  W * T**H
605*bf2c3715SXin Li*
606*bf2c3715SXin Li               CALL ZTRMM( 'Right', 'Upper', TRANS, 'Non-unit',
607*bf2c3715SXin Li     $              LASTC, K, ONE, T, LDT, WORK, LDWORK )
608*bf2c3715SXin Li*
609*bf2c3715SXin Li*              C := C - W * V
610*bf2c3715SXin Li*
611*bf2c3715SXin Li               IF( LASTV.GT.K ) THEN
612*bf2c3715SXin Li*
613*bf2c3715SXin Li*                 C2 := C2 - W * V2
614*bf2c3715SXin Li*
615*bf2c3715SXin Li                  CALL ZGEMM( 'No transpose', 'No transpose',
616*bf2c3715SXin Li     $                 LASTC, LASTV-K, K,
617*bf2c3715SXin Li     $                 -ONE, WORK, LDWORK, V( 1, K+1 ), LDV,
618*bf2c3715SXin Li     $                 ONE, C( 1, K+1 ), LDC )
619*bf2c3715SXin Li               END IF
620*bf2c3715SXin Li*
621*bf2c3715SXin Li*              W := W * V1
622*bf2c3715SXin Li*
623*bf2c3715SXin Li               CALL ZTRMM( 'Right', 'Upper', 'No transpose', 'Unit',
624*bf2c3715SXin Li     $              LASTC, K, ONE, V, LDV, WORK, LDWORK )
625*bf2c3715SXin Li*
626*bf2c3715SXin Li*              C1 := C1 - W
627*bf2c3715SXin Li*
628*bf2c3715SXin Li               DO 180 J = 1, K
629*bf2c3715SXin Li                  DO 170 I = 1, LASTC
630*bf2c3715SXin Li                     C( I, J ) = C( I, J ) - WORK( I, J )
631*bf2c3715SXin Li  170             CONTINUE
632*bf2c3715SXin Li  180          CONTINUE
633*bf2c3715SXin Li*
634*bf2c3715SXin Li            END IF
635*bf2c3715SXin Li*
636*bf2c3715SXin Li         ELSE
637*bf2c3715SXin Li*
638*bf2c3715SXin Li*           Let  V =  ( V1  V2 )    (V2: last K columns)
639*bf2c3715SXin Li*           where  V2  is unit lower triangular.
640*bf2c3715SXin Li*
641*bf2c3715SXin Li            IF( LSAME( SIDE, 'L' ) ) THEN
642*bf2c3715SXin Li*
643*bf2c3715SXin Li*              Form  H * C  or  H**H * C  where  C = ( C1 )
644*bf2c3715SXin Li*                                                    ( C2 )
645*bf2c3715SXin Li*
646*bf2c3715SXin Li               LASTV = MAX( K, ILAZLC( K, M, V, LDV ) )
647*bf2c3715SXin Li               LASTC = ILAZLC( LASTV, N, C, LDC )
648*bf2c3715SXin Li*
649*bf2c3715SXin Li*              W := C**H * V**H  =  (C1**H * V1**H + C2**H * V2**H) (stored in WORK)
650*bf2c3715SXin Li*
651*bf2c3715SXin Li*              W := C2**H
652*bf2c3715SXin Li*
653*bf2c3715SXin Li               DO 190 J = 1, K
654*bf2c3715SXin Li                  CALL ZCOPY( LASTC, C( LASTV-K+J, 1 ), LDC,
655*bf2c3715SXin Li     $                 WORK( 1, J ), 1 )
656*bf2c3715SXin Li                  CALL ZLACGV( LASTC, WORK( 1, J ), 1 )
657*bf2c3715SXin Li  190          CONTINUE
658*bf2c3715SXin Li*
659*bf2c3715SXin Li*              W := W * V2**H
660*bf2c3715SXin Li*
661*bf2c3715SXin Li               CALL ZTRMM( 'Right', 'Lower', 'Conjugate transpose',
662*bf2c3715SXin Li     $              'Unit', LASTC, K, ONE, V( 1, LASTV-K+1 ), LDV,
663*bf2c3715SXin Li     $              WORK, LDWORK )
664*bf2c3715SXin Li               IF( LASTV.GT.K ) THEN
665*bf2c3715SXin Li*
666*bf2c3715SXin Li*                 W := W + C1**H * V1**H
667*bf2c3715SXin Li*
668*bf2c3715SXin Li                  CALL ZGEMM( 'Conjugate transpose',
669*bf2c3715SXin Li     $                 'Conjugate transpose', LASTC, K, LASTV-K,
670*bf2c3715SXin Li     $                 ONE, C, LDC, V, LDV, ONE, WORK, LDWORK )
671*bf2c3715SXin Li               END IF
672*bf2c3715SXin Li*
673*bf2c3715SXin Li*              W := W * T**H  or  W * T
674*bf2c3715SXin Li*
675*bf2c3715SXin Li               CALL ZTRMM( 'Right', 'Lower', TRANST, 'Non-unit',
676*bf2c3715SXin Li     $              LASTC, K, ONE, T, LDT, WORK, LDWORK )
677*bf2c3715SXin Li*
678*bf2c3715SXin Li*              C := C - V**H * W**H
679*bf2c3715SXin Li*
680*bf2c3715SXin Li               IF( LASTV.GT.K ) THEN
681*bf2c3715SXin Li*
682*bf2c3715SXin Li*                 C1 := C1 - V1**H * W**H
683*bf2c3715SXin Li*
684*bf2c3715SXin Li                  CALL ZGEMM( 'Conjugate transpose',
685*bf2c3715SXin Li     $                 'Conjugate transpose', LASTV-K, LASTC, K,
686*bf2c3715SXin Li     $                 -ONE, V, LDV, WORK, LDWORK, ONE, C, LDC )
687*bf2c3715SXin Li               END IF
688*bf2c3715SXin Li*
689*bf2c3715SXin Li*              W := W * V2
690*bf2c3715SXin Li*
691*bf2c3715SXin Li               CALL ZTRMM( 'Right', 'Lower', 'No transpose', 'Unit',
692*bf2c3715SXin Li     $              LASTC, K, ONE, V( 1, LASTV-K+1 ), LDV,
693*bf2c3715SXin Li     $              WORK, LDWORK )
694*bf2c3715SXin Li*
695*bf2c3715SXin Li*              C2 := C2 - W**H
696*bf2c3715SXin Li*
697*bf2c3715SXin Li               DO 210 J = 1, K
698*bf2c3715SXin Li                  DO 200 I = 1, LASTC
699*bf2c3715SXin Li                     C( LASTV-K+J, I ) = C( LASTV-K+J, I ) -
700*bf2c3715SXin Li     $                               DCONJG( WORK( I, J ) )
701*bf2c3715SXin Li  200             CONTINUE
702*bf2c3715SXin Li  210          CONTINUE
703*bf2c3715SXin Li*
704*bf2c3715SXin Li            ELSE IF( LSAME( SIDE, 'R' ) ) THEN
705*bf2c3715SXin Li*
706*bf2c3715SXin Li*              Form  C * H  or  C * H**H  where  C = ( C1  C2 )
707*bf2c3715SXin Li*
708*bf2c3715SXin Li               LASTV = MAX( K, ILAZLC( K, N, V, LDV ) )
709*bf2c3715SXin Li               LASTC = ILAZLR( M, LASTV, C, LDC )
710*bf2c3715SXin Li*
711*bf2c3715SXin Li*              W := C * V**H  =  (C1*V1**H + C2*V2**H)  (stored in WORK)
712*bf2c3715SXin Li*
713*bf2c3715SXin Li*              W := C2
714*bf2c3715SXin Li*
715*bf2c3715SXin Li               DO 220 J = 1, K
716*bf2c3715SXin Li                  CALL ZCOPY( LASTC, C( 1, LASTV-K+J ), 1,
717*bf2c3715SXin Li     $                 WORK( 1, J ), 1 )
718*bf2c3715SXin Li  220          CONTINUE
719*bf2c3715SXin Li*
720*bf2c3715SXin Li*              W := W * V2**H
721*bf2c3715SXin Li*
722*bf2c3715SXin Li               CALL ZTRMM( 'Right', 'Lower', 'Conjugate transpose',
723*bf2c3715SXin Li     $              'Unit', LASTC, K, ONE, V( 1, LASTV-K+1 ), LDV,
724*bf2c3715SXin Li     $              WORK, LDWORK )
725*bf2c3715SXin Li               IF( LASTV.GT.K ) THEN
726*bf2c3715SXin Li*
727*bf2c3715SXin Li*                 W := W + C1 * V1**H
728*bf2c3715SXin Li*
729*bf2c3715SXin Li                  CALL ZGEMM( 'No transpose', 'Conjugate transpose',
730*bf2c3715SXin Li     $                 LASTC, K, LASTV-K, ONE, C, LDC, V, LDV, ONE,
731*bf2c3715SXin Li     $                 WORK, LDWORK )
732*bf2c3715SXin Li               END IF
733*bf2c3715SXin Li*
734*bf2c3715SXin Li*              W := W * T  or  W * T**H
735*bf2c3715SXin Li*
736*bf2c3715SXin Li               CALL ZTRMM( 'Right', 'Lower', TRANS, 'Non-unit',
737*bf2c3715SXin Li     $              LASTC, K, ONE, T, LDT, WORK, LDWORK )
738*bf2c3715SXin Li*
739*bf2c3715SXin Li*              C := C - W * V
740*bf2c3715SXin Li*
741*bf2c3715SXin Li               IF( LASTV.GT.K ) THEN
742*bf2c3715SXin Li*
743*bf2c3715SXin Li*                 C1 := C1 - W * V1
744*bf2c3715SXin Li*
745*bf2c3715SXin Li                  CALL ZGEMM( 'No transpose', 'No transpose',
746*bf2c3715SXin Li     $                 LASTC, LASTV-K, K, -ONE, WORK, LDWORK, V, LDV,
747*bf2c3715SXin Li     $                 ONE, C, LDC )
748*bf2c3715SXin Li               END IF
749*bf2c3715SXin Li*
750*bf2c3715SXin Li*              W := W * V2
751*bf2c3715SXin Li*
752*bf2c3715SXin Li               CALL ZTRMM( 'Right', 'Lower', 'No transpose', 'Unit',
753*bf2c3715SXin Li     $              LASTC, K, ONE, V( 1, LASTV-K+1 ), LDV,
754*bf2c3715SXin Li     $              WORK, LDWORK )
755*bf2c3715SXin Li*
756*bf2c3715SXin Li*              C1 := C1 - W
757*bf2c3715SXin Li*
758*bf2c3715SXin Li               DO 240 J = 1, K
759*bf2c3715SXin Li                  DO 230 I = 1, LASTC
760*bf2c3715SXin Li                     C( I, LASTV-K+J ) = C( I, LASTV-K+J )
761*bf2c3715SXin Li     $                    - WORK( I, J )
762*bf2c3715SXin Li  230             CONTINUE
763*bf2c3715SXin Li  240          CONTINUE
764*bf2c3715SXin Li*
765*bf2c3715SXin Li            END IF
766*bf2c3715SXin Li*
767*bf2c3715SXin Li         END IF
768*bf2c3715SXin Li      END IF
769*bf2c3715SXin Li*
770*bf2c3715SXin Li      RETURN
771*bf2c3715SXin Li*
772*bf2c3715SXin Li*     End of ZLARFB
773*bf2c3715SXin Li*
774*bf2c3715SXin Li      END
775