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