001:       SUBROUTINE ZLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV,
002:      $                   T, LDT, C, LDC, WORK, LDWORK )
003:       IMPLICIT NONE
004: *
005: *  -- LAPACK auxiliary routine (version 3.2) --
006: *     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
007: *     November 2006
008: *
009: *     .. Scalar Arguments ..
010:       CHARACTER          DIRECT, SIDE, STOREV, TRANS
011:       INTEGER            K, LDC, LDT, LDV, LDWORK, M, N
012: *     ..
013: *     .. Array Arguments ..
014:       COMPLEX*16         C( LDC, * ), T( LDT, * ), V( LDV, * ),
015:      $                   WORK( LDWORK, * )
016: *     ..
017: *
018: *  Purpose
019: *  =======
020: *
021: *  ZLARFB applies a complex block reflector H or its transpose H' to a
022: *  complex M-by-N matrix C, from either the left or the right.
023: *
024: *  Arguments
025: *  =========
026: *
027: *  SIDE    (input) CHARACTER*1
028: *          = 'L': apply H or H' from the Left
029: *          = 'R': apply H or H' from the Right
030: *
031: *  TRANS   (input) CHARACTER*1
032: *          = 'N': apply H (No transpose)
033: *          = 'C': apply H' (Conjugate transpose)
034: *
035: *  DIRECT  (input) CHARACTER*1
036: *          Indicates how H is formed from a product of elementary
037: *          reflectors
038: *          = 'F': H = H(1) H(2) . . . H(k) (Forward)
039: *          = 'B': H = H(k) . . . H(2) H(1) (Backward)
040: *
041: *  STOREV  (input) CHARACTER*1
042: *          Indicates how the vectors which define the elementary
043: *          reflectors are stored:
044: *          = 'C': Columnwise
045: *          = 'R': Rowwise
046: *
047: *  M       (input) INTEGER
048: *          The number of rows of the matrix C.
049: *
050: *  N       (input) INTEGER
051: *          The number of columns of the matrix C.
052: *
053: *  K       (input) INTEGER
054: *          The order of the matrix T (= the number of elementary
055: *          reflectors whose product defines the block reflector).
056: *
057: *  V       (input) COMPLEX*16 array, dimension
058: *                                (LDV,K) if STOREV = 'C'
059: *                                (LDV,M) if STOREV = 'R' and SIDE = 'L'
060: *                                (LDV,N) if STOREV = 'R' and SIDE = 'R'
061: *          The matrix V. See further details.
062: *
063: *  LDV     (input) INTEGER
064: *          The leading dimension of the array V.
065: *          If STOREV = 'C' and SIDE = 'L', LDV >= max(1,M);
066: *          if STOREV = 'C' and SIDE = 'R', LDV >= max(1,N);
067: *          if STOREV = 'R', LDV >= K.
068: *
069: *  T       (input) COMPLEX*16 array, dimension (LDT,K)
070: *          The triangular K-by-K matrix T in the representation of the
071: *          block reflector.
072: *
073: *  LDT     (input) INTEGER
074: *          The leading dimension of the array T. LDT >= K.
075: *
076: *  C       (input/output) COMPLEX*16 array, dimension (LDC,N)
077: *          On entry, the M-by-N matrix C.
078: *          On exit, C is overwritten by H*C or H'*C or C*H or C*H'.
079: *
080: *  LDC     (input) INTEGER
081: *          The leading dimension of the array C. LDC >= max(1,M).
082: *
083: *  WORK    (workspace) COMPLEX*16 array, dimension (LDWORK,K)
084: *
085: *  LDWORK  (input) INTEGER
086: *          The leading dimension of the array WORK.
087: *          If SIDE = 'L', LDWORK >= max(1,N);
088: *          if SIDE = 'R', LDWORK >= max(1,M).
089: *
090: *  =====================================================================
091: *
092: *     .. Parameters ..
093:       COMPLEX*16         ONE
094:       PARAMETER          ( ONE = ( 1.0D+0, 0.0D+0 ) )
095: *     ..
096: *     .. Local Scalars ..
097:       CHARACTER          TRANST
098:       INTEGER            I, J, LASTV, LASTC
099: *     ..
100: *     .. External Functions ..
101:       LOGICAL            LSAME
102:       INTEGER            ILAZLR, ILAZLC
103:       EXTERNAL           LSAME, ILAZLR, ILAZLC
104: *     ..
105: *     .. External Subroutines ..
106:       EXTERNAL           ZCOPY, ZGEMM, ZLACGV, ZTRMM
107: *     ..
108: *     .. Intrinsic Functions ..
109:       INTRINSIC          DCONJG
110: *     ..
111: *     .. Executable Statements ..
112: *
113: *     Quick return if possible
114: *
115:       IF( M.LE.0 .OR. N.LE.0 )
116:      $   RETURN
117: *
118:       IF( LSAME( TRANS, 'N' ) ) THEN
119:          TRANST = 'C'
120:       ELSE
121:          TRANST = 'N'
122:       END IF
123: *
124:       IF( LSAME( STOREV, 'C' ) ) THEN
125: *
126:          IF( LSAME( DIRECT, 'F' ) ) THEN
127: *
128: *           Let  V =  ( V1 )    (first K rows)
129: *                     ( V2 )
130: *           where  V1  is unit lower triangular.
131: *
132:             IF( LSAME( SIDE, 'L' ) ) THEN
133: *
134: *              Form  H * C  or  H' * C  where  C = ( C1 )
135: *                                                  ( C2 )
136: *
137:                LASTV = MAX( K, ILAZLR( M, K, V, LDV ) )
138:                LASTC = ILAZLC( LASTV, N, C, LDC )
139: *
140: *              W := C' * V  =  (C1'*V1 + C2'*V2)  (stored in WORK)
141: *
142: *              W := C1'
143: *
144:                DO 10 J = 1, K
145:                   CALL ZCOPY( LASTC, C( J, 1 ), LDC, WORK( 1, J ), 1 )
146:                   CALL ZLACGV( LASTC, WORK( 1, J ), 1 )
147:    10          CONTINUE
148: *
149: *              W := W * V1
150: *
151:                CALL ZTRMM( 'Right', 'Lower', 'No transpose', 'Unit',
152:      $              LASTC, K, ONE, V, LDV, WORK, LDWORK )
153:                IF( LASTV.GT.K ) THEN
154: *
155: *                 W := W + C2'*V2
156: *
157:                   CALL ZGEMM( 'Conjugate transpose', 'No transpose',
158:      $                 LASTC, K, LASTV-K, ONE, C( K+1, 1 ), LDC,
159:      $                 V( K+1, 1 ), LDV, ONE, WORK, LDWORK )
160:                END IF
161: *
162: *              W := W * T'  or  W * T
163: *
164:                CALL ZTRMM( 'Right', 'Upper', TRANST, 'Non-unit',
165:      $              LASTC, K, ONE, T, LDT, WORK, LDWORK )
166: *
167: *              C := C - V * W'
168: *
169:                IF( M.GT.K ) THEN
170: *
171: *                 C2 := C2 - V2 * W'
172: *
173:                   CALL ZGEMM( 'No transpose', 'Conjugate transpose',
174:      $                 LASTV-K, LASTC, K,
175:      $                 -ONE, V( K+1, 1 ), LDV, WORK, LDWORK,
176:      $                 ONE, C( K+1, 1 ), LDC )
177:                END IF
178: *
179: *              W := W * V1'
180: *
181:                CALL ZTRMM( 'Right', 'Lower', 'Conjugate transpose',
182:      $              'Unit', LASTC, K, ONE, V, LDV, WORK, LDWORK )
183: *
184: *              C1 := C1 - W'
185: *
186:                DO 30 J = 1, K
187:                   DO 20 I = 1, LASTC
188:                      C( J, I ) = C( J, I ) - DCONJG( WORK( I, J ) )
189:    20             CONTINUE
190:    30          CONTINUE
191: *
192:             ELSE IF( LSAME( SIDE, 'R' ) ) THEN
193: *
194: *              Form  C * H  or  C * H'  where  C = ( C1  C2 )
195: *
196:                LASTV = MAX( K, ILAZLR( N, K, V, LDV ) )
197:                LASTC = ILAZLR( M, LASTV, C, LDC )
198: *
199: *              W := C * V  =  (C1*V1 + C2*V2)  (stored in WORK)
200: *
201: *              W := C1
202: *
203:                DO 40 J = 1, K
204:                   CALL ZCOPY( LASTC, C( 1, J ), 1, WORK( 1, J ), 1 )
205:    40          CONTINUE
206: *
207: *              W := W * V1
208: *
209:                CALL ZTRMM( 'Right', 'Lower', 'No transpose', 'Unit',
210:      $              LASTC, K, ONE, V, LDV, WORK, LDWORK )
211:                IF( LASTV.GT.K ) THEN
212: *
213: *                 W := W + C2 * V2
214: *
215:                   CALL ZGEMM( 'No transpose', 'No transpose',
216:      $                 LASTC, K, LASTV-K,
217:      $                 ONE, C( 1, K+1 ), LDC, V( K+1, 1 ), LDV,
218:      $                 ONE, WORK, LDWORK )
219:                END IF
220: *
221: *              W := W * T  or  W * T'
222: *
223:                CALL ZTRMM( 'Right', 'Upper', TRANS, 'Non-unit',
224:      $              LASTC, K, ONE, T, LDT, WORK, LDWORK )
225: *
226: *              C := C - W * V'
227: *
228:                IF( LASTV.GT.K ) THEN
229: *
230: *                 C2 := C2 - W * V2'
231: *
232:                   CALL ZGEMM( 'No transpose', 'Conjugate transpose',
233:      $                 LASTC, LASTV-K, K,
234:      $                 -ONE, WORK, LDWORK, V( K+1, 1 ), LDV,
235:      $                 ONE, C( 1, K+1 ), LDC )
236:                END IF
237: *
238: *              W := W * V1'
239: *
240:                CALL ZTRMM( 'Right', 'Lower', 'Conjugate transpose',
241:      $              'Unit', LASTC, K, ONE, V, LDV, WORK, LDWORK )
242: *
243: *              C1 := C1 - W
244: *
245:                DO 60 J = 1, K
246:                   DO 50 I = 1, LASTC
247:                      C( I, J ) = C( I, J ) - WORK( I, J )
248:    50             CONTINUE
249:    60          CONTINUE
250:             END IF
251: *
252:          ELSE
253: *
254: *           Let  V =  ( V1 )
255: *                     ( V2 )    (last K rows)
256: *           where  V2  is unit upper triangular.
257: *
258:             IF( LSAME( SIDE, 'L' ) ) THEN
259: *
260: *              Form  H * C  or  H' * C  where  C = ( C1 )
261: *                                                  ( C2 )
262: *
263:                LASTV = MAX( K, ILAZLR( M, K, V, LDV ) )
264:                LASTC = ILAZLC( LASTV, N, C, LDC )
265: *
266: *              W := C' * V  =  (C1'*V1 + C2'*V2)  (stored in WORK)
267: *
268: *              W := C2'
269: *
270:                DO 70 J = 1, K
271:                   CALL ZCOPY( LASTC, C( LASTV-K+J, 1 ), LDC,
272:      $                 WORK( 1, J ), 1 )
273:                   CALL ZLACGV( LASTC, WORK( 1, J ), 1 )
274:    70          CONTINUE
275: *
276: *              W := W * V2
277: *
278:                CALL ZTRMM( 'Right', 'Upper', 'No transpose', 'Unit',
279:      $              LASTC, K, ONE, V( LASTV-K+1, 1 ), LDV,
280:      $              WORK, LDWORK )
281:                IF( LASTV.GT.K ) THEN
282: *
283: *                 W := W + C1'*V1
284: *
285:                   CALL ZGEMM( 'Conjugate transpose', 'No transpose',
286:      $                 LASTC, K, LASTV-K,
287:      $                 ONE, C, LDC, V, LDV,
288:      $                 ONE, WORK, LDWORK )
289:                END IF
290: *
291: *              W := W * T'  or  W * T
292: *
293:                CALL ZTRMM( 'Right', 'Lower', TRANST, 'Non-unit',
294:      $              LASTC, K, ONE, T, LDT, WORK, LDWORK )
295: *
296: *              C := C - V * W'
297: *
298:                IF( LASTV.GT.K ) THEN
299: *
300: *                 C1 := C1 - V1 * W'
301: *
302:                   CALL ZGEMM( 'No transpose', 'Conjugate transpose',
303:      $                 LASTV-K, LASTC, K,
304:      $                 -ONE, V, LDV, WORK, LDWORK,
305:      $                 ONE, C, LDC )
306:                END IF
307: *
308: *              W := W * V2'
309: *
310:                CALL ZTRMM( 'Right', 'Upper', 'Conjugate transpose',
311:      $              'Unit', LASTC, K, ONE, V( LASTV-K+1, 1 ), LDV,
312:      $              WORK, LDWORK )
313: *
314: *              C2 := C2 - W'
315: *
316:                DO 90 J = 1, K
317:                   DO 80 I = 1, LASTC
318:                      C( LASTV-K+J, I ) = C( LASTV-K+J, I ) -
319:      $                               DCONJG( WORK( I, J ) )
320:    80             CONTINUE
321:    90          CONTINUE
322: *
323:             ELSE IF( LSAME( SIDE, 'R' ) ) THEN
324: *
325: *              Form  C * H  or  C * H'  where  C = ( C1  C2 )
326: *
327:                LASTV = MAX( K, ILAZLR( N, K, V, LDV ) )
328:                LASTC = ILAZLR( M, LASTV, C, LDC )
329: *
330: *              W := C * V  =  (C1*V1 + C2*V2)  (stored in WORK)
331: *
332: *              W := C2
333: *
334:                DO 100 J = 1, K
335:                   CALL ZCOPY( LASTC, C( 1, LASTV-K+J ), 1,
336:      $                 WORK( 1, J ), 1 )
337:   100          CONTINUE
338: *
339: *              W := W * V2
340: *
341:                CALL ZTRMM( 'Right', 'Upper', 'No transpose', 'Unit',
342:      $              LASTC, K, ONE, V( LASTV-K+1, 1 ), LDV,
343:      $              WORK, LDWORK )
344:                IF( LASTV.GT.K ) THEN
345: *
346: *                 W := W + C1 * V1
347: *
348:                   CALL ZGEMM( 'No transpose', 'No transpose',
349:      $                 LASTC, K, LASTV-K,
350:      $                 ONE, C, LDC, V, LDV, ONE, WORK, LDWORK )
351:                END IF
352: *
353: *              W := W * T  or  W * T'
354: *
355:                CALL ZTRMM( 'Right', 'Lower', TRANS, 'Non-unit',
356:      $              LASTC, K, ONE, T, LDT, WORK, LDWORK )
357: *
358: *              C := C - W * V'
359: *
360:                IF( LASTV.GT.K ) THEN
361: *
362: *                 C1 := C1 - W * V1'
363: *
364:                   CALL ZGEMM( 'No transpose', 'Conjugate transpose',
365:      $                 LASTC, LASTV-K, K, -ONE, WORK, LDWORK, V, LDV,
366:      $                 ONE, C, LDC )
367:                END IF
368: *
369: *              W := W * V2'
370: *
371:                CALL ZTRMM( 'Right', 'Upper', 'Conjugate transpose',
372:      $              'Unit', LASTC, K, ONE, V( LASTV-K+1, 1 ), LDV,
373:      $              WORK, LDWORK )
374: *
375: *              C2 := C2 - W
376: *
377:                DO 120 J = 1, K
378:                   DO 110 I = 1, LASTC
379:                      C( I, LASTV-K+J ) = C( I, LASTV-K+J )
380:      $                    - WORK( I, J )
381:   110             CONTINUE
382:   120          CONTINUE
383:             END IF
384:          END IF
385: *
386:       ELSE IF( LSAME( STOREV, 'R' ) ) THEN
387: *
388:          IF( LSAME( DIRECT, 'F' ) ) THEN
389: *
390: *           Let  V =  ( V1  V2 )    (V1: first K columns)
391: *           where  V1  is unit upper triangular.
392: *
393:             IF( LSAME( SIDE, 'L' ) ) THEN
394: *
395: *              Form  H * C  or  H' * C  where  C = ( C1 )
396: *                                                  ( C2 )
397: *
398:                LASTV = MAX( K, ILAZLC( K, M, V, LDV ) )
399:                LASTC = ILAZLC( LASTV, N, C, LDC )
400: *
401: *              W := C' * V'  =  (C1'*V1' + C2'*V2') (stored in WORK)
402: *
403: *              W := C1'
404: *
405:                DO 130 J = 1, K
406:                   CALL ZCOPY( LASTC, C( J, 1 ), LDC, WORK( 1, J ), 1 )
407:                   CALL ZLACGV( LASTC, WORK( 1, J ), 1 )
408:   130          CONTINUE
409: *
410: *              W := W * V1'
411: *
412:                CALL ZTRMM( 'Right', 'Upper', 'Conjugate transpose',
413:      $                     'Unit', LASTC, K, ONE, V, LDV, WORK, LDWORK )
414:                IF( LASTV.GT.K ) THEN
415: *
416: *                 W := W + C2'*V2'
417: *
418:                   CALL ZGEMM( 'Conjugate transpose',
419:      $                 'Conjugate transpose', LASTC, K, LASTV-K,
420:      $                 ONE, C( K+1, 1 ), LDC, V( 1, K+1 ), LDV,
421:      $                 ONE, WORK, LDWORK )
422:                END IF
423: *
424: *              W := W * T'  or  W * T
425: *
426:                CALL ZTRMM( 'Right', 'Upper', TRANST, 'Non-unit',
427:      $              LASTC, K, ONE, T, LDT, WORK, LDWORK )
428: *
429: *              C := C - V' * W'
430: *
431:                IF( LASTV.GT.K ) THEN
432: *
433: *                 C2 := C2 - V2' * W'
434: *
435:                   CALL ZGEMM( 'Conjugate transpose',
436:      $                 'Conjugate transpose', LASTV-K, LASTC, K,
437:      $                 -ONE, V( 1, K+1 ), LDV, WORK, LDWORK,
438:      $                 ONE, C( K+1, 1 ), LDC )
439:                END IF
440: *
441: *              W := W * V1
442: *
443:                CALL ZTRMM( 'Right', 'Upper', 'No transpose', 'Unit',
444:      $              LASTC, K, ONE, V, LDV, WORK, LDWORK )
445: *
446: *              C1 := C1 - W'
447: *
448:                DO 150 J = 1, K
449:                   DO 140 I = 1, LASTC
450:                      C( J, I ) = C( J, I ) - DCONJG( WORK( I, J ) )
451:   140             CONTINUE
452:   150          CONTINUE
453: *
454:             ELSE IF( LSAME( SIDE, 'R' ) ) THEN
455: *
456: *              Form  C * H  or  C * H'  where  C = ( C1  C2 )
457: *
458:                LASTV = MAX( K, ILAZLC( K, N, V, LDV ) )
459:                LASTC = ILAZLR( M, LASTV, C, LDC )
460: *
461: *              W := C * V'  =  (C1*V1' + C2*V2')  (stored in WORK)
462: *
463: *              W := C1
464: *
465:                DO 160 J = 1, K
466:                   CALL ZCOPY( LASTC, C( 1, J ), 1, WORK( 1, J ), 1 )
467:   160          CONTINUE
468: *
469: *              W := W * V1'
470: *
471:                CALL ZTRMM( 'Right', 'Upper', 'Conjugate transpose',
472:      $                     'Unit', LASTC, K, ONE, V, LDV, WORK, LDWORK )
473:                IF( LASTV.GT.K ) THEN
474: *
475: *                 W := W + C2 * V2'
476: *
477:                   CALL ZGEMM( 'No transpose', 'Conjugate transpose',
478:      $                 LASTC, K, LASTV-K, ONE, C( 1, K+1 ), LDC,
479:      $                 V( 1, K+1 ), LDV, ONE, WORK, LDWORK )
480:                END IF
481: *
482: *              W := W * T  or  W * T'
483: *
484:                CALL ZTRMM( 'Right', 'Upper', TRANS, 'Non-unit',
485:      $              LASTC, K, ONE, T, LDT, WORK, LDWORK )
486: *
487: *              C := C - W * V
488: *
489:                IF( LASTV.GT.K ) THEN
490: *
491: *                 C2 := C2 - W * V2
492: *
493:                   CALL ZGEMM( 'No transpose', 'No transpose',
494:      $                 LASTC, LASTV-K, K,
495:      $                 -ONE, WORK, LDWORK, V( 1, K+1 ), LDV,
496:      $                 ONE, C( 1, K+1 ), LDC )
497:                END IF
498: *
499: *              W := W * V1
500: *
501:                CALL ZTRMM( 'Right', 'Upper', 'No transpose', 'Unit',
502:      $              LASTC, K, ONE, V, LDV, WORK, LDWORK )
503: *
504: *              C1 := C1 - W
505: *
506:                DO 180 J = 1, K
507:                   DO 170 I = 1, LASTC
508:                      C( I, J ) = C( I, J ) - WORK( I, J )
509:   170             CONTINUE
510:   180          CONTINUE
511: *
512:             END IF
513: *
514:          ELSE
515: *
516: *           Let  V =  ( V1  V2 )    (V2: last K columns)
517: *           where  V2  is unit lower triangular.
518: *
519:             IF( LSAME( SIDE, 'L' ) ) THEN
520: *
521: *              Form  H * C  or  H' * C  where  C = ( C1 )
522: *                                                  ( C2 )
523: *
524:                LASTV = MAX( K, ILAZLC( K, M, V, LDV ) )
525:                LASTC = ILAZLC( LASTV, N, C, LDC )
526: *
527: *              W := C' * V'  =  (C1'*V1' + C2'*V2') (stored in WORK)
528: *
529: *              W := C2'
530: *
531:                DO 190 J = 1, K
532:                   CALL ZCOPY( LASTC, C( LASTV-K+J, 1 ), LDC,
533:      $                 WORK( 1, J ), 1 )
534:                   CALL ZLACGV( LASTC, WORK( 1, J ), 1 )
535:   190          CONTINUE
536: *
537: *              W := W * V2'
538: *
539:                CALL ZTRMM( 'Right', 'Lower', 'Conjugate transpose',
540:      $              'Unit', LASTC, K, ONE, V( 1, LASTV-K+1 ), LDV,
541:      $              WORK, LDWORK )
542:                IF( LASTV.GT.K ) THEN
543: *
544: *                 W := W + C1'*V1'
545: *
546:                   CALL ZGEMM( 'Conjugate transpose',
547:      $                 'Conjugate transpose', LASTC, K, LASTV-K,
548:      $                 ONE, C, LDC, V, LDV, ONE, WORK, LDWORK )
549:                END IF
550: *
551: *              W := W * T'  or  W * T
552: *
553:                CALL ZTRMM( 'Right', 'Lower', TRANST, 'Non-unit',
554:      $              LASTC, K, ONE, T, LDT, WORK, LDWORK )
555: *
556: *              C := C - V' * W'
557: *
558:                IF( LASTV.GT.K ) THEN
559: *
560: *                 C1 := C1 - V1' * W'
561: *
562:                   CALL ZGEMM( 'Conjugate transpose',
563:      $                 'Conjugate transpose', LASTV-K, LASTC, K,
564:      $                 -ONE, V, LDV, WORK, LDWORK, ONE, C, LDC )
565:                END IF
566: *
567: *              W := W * V2
568: *
569:                CALL ZTRMM( 'Right', 'Lower', 'No transpose', 'Unit',
570:      $              LASTC, K, ONE, V( 1, LASTV-K+1 ), LDV,
571:      $              WORK, LDWORK )
572: *
573: *              C2 := C2 - W'
574: *
575:                DO 210 J = 1, K
576:                   DO 200 I = 1, LASTC
577:                      C( LASTV-K+J, I ) = C( LASTV-K+J, I ) -
578:      $                               DCONJG( WORK( I, J ) )
579:   200             CONTINUE
580:   210          CONTINUE
581: *
582:             ELSE IF( LSAME( SIDE, 'R' ) ) THEN
583: *
584: *              Form  C * H  or  C * H'  where  C = ( C1  C2 )
585: *
586:                LASTV = MAX( K, ILAZLC( K, N, V, LDV ) )
587:                LASTC = ILAZLR( M, LASTV, C, LDC )
588: *
589: *              W := C * V'  =  (C1*V1' + C2*V2')  (stored in WORK)
590: *
591: *              W := C2
592: *
593:                DO 220 J = 1, K
594:                   CALL ZCOPY( LASTC, C( 1, LASTV-K+J ), 1,
595:      $                 WORK( 1, J ), 1 )
596:   220          CONTINUE
597: *
598: *              W := W * V2'
599: *
600:                CALL ZTRMM( 'Right', 'Lower', 'Conjugate transpose',
601:      $              'Unit', LASTC, K, ONE, V( 1, LASTV-K+1 ), LDV,
602:      $              WORK, LDWORK )
603:                IF( LASTV.GT.K ) THEN
604: *
605: *                 W := W + C1 * V1'
606: *
607:                   CALL ZGEMM( 'No transpose', 'Conjugate transpose',
608:      $                 LASTC, K, LASTV-K, ONE, C, LDC, V, LDV, ONE,
609:      $                 WORK, LDWORK )
610:                END IF
611: *
612: *              W := W * T  or  W * T'
613: *
614:                CALL ZTRMM( 'Right', 'Lower', TRANS, 'Non-unit',
615:      $              LASTC, K, ONE, T, LDT, WORK, LDWORK )
616: *
617: *              C := C - W * V
618: *
619:                IF( LASTV.GT.K ) THEN
620: *
621: *                 C1 := C1 - W * V1
622: *
623:                   CALL ZGEMM( 'No transpose', 'No transpose',
624:      $                 LASTC, LASTV-K, K, -ONE, WORK, LDWORK, V, LDV,
625:      $                 ONE, C, LDC )
626:                END IF
627: *
628: *              W := W * V2
629: *
630:                CALL ZTRMM( 'Right', 'Lower', 'No transpose', 'Unit',
631:      $              LASTC, K, ONE, V( 1, LASTV-K+1 ), LDV,
632:      $              WORK, LDWORK )
633: *
634: *              C1 := C1 - W
635: *
636:                DO 240 J = 1, K
637:                   DO 230 I = 1, LASTC
638:                      C( I, LASTV-K+J ) = C( I, LASTV-K+J )
639:      $                    - WORK( I, J )
640:   230             CONTINUE
641:   240          CONTINUE
642: *
643:             END IF
644: *
645:          END IF
646:       END IF
647: *
648:       RETURN
649: *
650: *     End of ZLARFB
651: *
652:       END
653: