001:       SUBROUTINE CLARFB( 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            C( LDC, * ), T( LDT, * ), V( LDV, * ),
015:      $                   WORK( LDWORK, * )
016: *     ..
017: *
018: *  Purpose
019: *  =======
020: *
021: *  CLARFB 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 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 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 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 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            ONE
094:       PARAMETER          ( ONE = ( 1.0E+0, 0.0E+0 ) )
095: *     ..
096: *     .. Local Scalars ..
097:       CHARACTER          TRANST
098:       INTEGER            I, J, LASTV, LASTC
099: *     ..
100: *     .. External Functions ..
101:       LOGICAL            LSAME
102:       INTEGER            ILACLR, ILACLC
103:       EXTERNAL           LSAME, ILACLR, ILACLC
104: *     ..
105: *     .. External Subroutines ..
106:       EXTERNAL           CCOPY, CGEMM, CLACGV, CTRMM
107: *     ..
108: *     .. Intrinsic Functions ..
109:       INTRINSIC          CONJG
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, ILACLR( M, K, V, LDV ) )
138:                LASTC = ILACLC( 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 CCOPY( LASTC, C( J, 1 ), LDC, WORK( 1, J ), 1 )
146:                   CALL CLACGV( LASTC, WORK( 1, J ), 1 )
147:    10          CONTINUE
148: *
149: *              W := W * V1
150: *
151:                CALL CTRMM( '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 CGEMM( '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 CTRMM( '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 CGEMM( 'No transpose', 'Conjugate transpose',
174:      $                 LASTV-K, LASTC, K, -ONE, V( K+1, 1 ), LDV,
175:      $                 WORK, LDWORK, ONE, C( K+1, 1 ), LDC )
176:                END IF
177: *
178: *              W := W * V1'
179: *
180:                CALL CTRMM( 'Right', 'Lower', 'Conjugate transpose',
181:      $              'Unit', LASTC, K, ONE, V, LDV, WORK, LDWORK )
182: *
183: *              C1 := C1 - W'
184: *
185:                DO 30 J = 1, K
186:                   DO 20 I = 1, LASTC
187:                      C( J, I ) = C( J, I ) - CONJG( WORK( I, J ) )
188:    20             CONTINUE
189:    30          CONTINUE
190: *
191:             ELSE IF( LSAME( SIDE, 'R' ) ) THEN
192: *
193: *              Form  C * H  or  C * H'  where  C = ( C1  C2 )
194: *
195:                LASTV = MAX( K, ILACLR( N, K, V, LDV ) )
196:                LASTC = ILACLR( M, LASTV, C, LDC )
197: *
198: *              W := C * V  =  (C1*V1 + C2*V2)  (stored in WORK)
199: *
200: *              W := C1
201: *
202:                DO 40 J = 1, K
203:                   CALL CCOPY( LASTC, C( 1, J ), 1, WORK( 1, J ), 1 )
204:    40          CONTINUE
205: *
206: *              W := W * V1
207: *
208:                CALL CTRMM( 'Right', 'Lower', 'No transpose', 'Unit',
209:      $              LASTC, K, ONE, V, LDV, WORK, LDWORK )
210:                IF( LASTV.GT.K ) THEN
211: *
212: *                 W := W + C2 * V2
213: *
214:                   CALL CGEMM( 'No transpose', 'No transpose',
215:      $                 LASTC, K, LASTV-K,
216:      $                 ONE, C( 1, K+1 ), LDC, V( K+1, 1 ), LDV,
217:      $                 ONE, WORK, LDWORK )
218:                END IF
219: *
220: *              W := W * T  or  W * T'
221: *
222:                CALL CTRMM( 'Right', 'Upper', TRANS, 'Non-unit',
223:      $              LASTC, K, ONE, T, LDT, WORK, LDWORK )
224: *
225: *              C := C - W * V'
226: *
227:                IF( LASTV.GT.K ) THEN
228: *
229: *                 C2 := C2 - W * V2'
230: *
231:                   CALL CGEMM( 'No transpose', 'Conjugate transpose',
232:      $                 LASTC, LASTV-K, K,
233:      $                 -ONE, WORK, LDWORK, V( K+1, 1 ), LDV,
234:      $                 ONE, C( 1, K+1 ), LDC )
235:                END IF
236: *
237: *              W := W * V1'
238: *
239:                CALL CTRMM( 'Right', 'Lower', 'Conjugate transpose',
240:      $              'Unit', LASTC, K, ONE, V, LDV, WORK, LDWORK )
241: *
242: *              C1 := C1 - W
243: *
244:                DO 60 J = 1, K
245:                   DO 50 I = 1, LASTC
246:                      C( I, J ) = C( I, J ) - WORK( I, J )
247:    50             CONTINUE
248:    60          CONTINUE
249:             END IF
250: *
251:          ELSE
252: *
253: *           Let  V =  ( V1 )
254: *                     ( V2 )    (last K rows)
255: *           where  V2  is unit upper triangular.
256: *
257:             IF( LSAME( SIDE, 'L' ) ) THEN
258: *
259: *              Form  H * C  or  H' * C  where  C = ( C1 )
260: *                                                  ( C2 )
261: *
262:                LASTV = MAX( K, ILACLR( M, K, V, LDV ) )
263:                LASTC = ILACLC( LASTV, N, C, LDC )
264: *
265: *              W := C' * V  =  (C1'*V1 + C2'*V2)  (stored in WORK)
266: *
267: *              W := C2'
268: *
269:                DO 70 J = 1, K
270:                   CALL CCOPY( LASTC, C( LASTV-K+J, 1 ), LDC,
271:      $                 WORK( 1, J ), 1 )
272:                   CALL CLACGV( LASTC, WORK( 1, J ), 1 )
273:    70          CONTINUE
274: *
275: *              W := W * V2
276: *
277:                CALL CTRMM( 'Right', 'Upper', 'No transpose', 'Unit',
278:      $              LASTC, K, ONE, V( LASTV-K+1, 1 ), LDV,
279:      $              WORK, LDWORK )
280:                IF( LASTV.GT.K ) THEN
281: *
282: *                 W := W + C1'*V1
283: *
284:                   CALL CGEMM( 'Conjugate transpose', 'No transpose',
285:      $                 LASTC, K, LASTV-K, ONE, C, LDC, V, LDV,
286:      $                 ONE, WORK, LDWORK )
287:                END IF
288: *
289: *              W := W * T'  or  W * T
290: *
291:                CALL CTRMM( 'Right', 'Lower', TRANST, 'Non-unit',
292:      $              LASTC, K, ONE, T, LDT, WORK, LDWORK )
293: *
294: *              C := C - V * W'
295: *
296:                IF( LASTV.GT.K ) THEN
297: *
298: *                 C1 := C1 - V1 * W'
299: *
300:                   CALL CGEMM( 'No transpose', 'Conjugate transpose',
301:      $                 LASTV-K, LASTC, K, -ONE, V, LDV, WORK, LDWORK,
302:      $                 ONE, C, LDC )
303:                END IF
304: *
305: *              W := W * V2'
306: *
307:                CALL CTRMM( 'Right', 'Upper', 'Conjugate transpose',
308:      $              'Unit', LASTC, K, ONE, V( LASTV-K+1, 1 ), LDV,
309:      $              WORK, LDWORK )
310: *
311: *              C2 := C2 - W'
312: *
313:                DO 90 J = 1, K
314:                   DO 80 I = 1, LASTC
315:                      C( LASTV-K+J, I ) = C( LASTV-K+J, I ) -
316:      $                               CONJG( WORK( I, J ) )
317:    80             CONTINUE
318:    90          CONTINUE
319: *
320:             ELSE IF( LSAME( SIDE, 'R' ) ) THEN
321: *
322: *              Form  C * H  or  C * H'  where  C = ( C1  C2 )
323: *
324:                LASTV = MAX( K, ILACLR( N, K, V, LDV ) )
325:                LASTC = ILACLR( M, LASTV, C, LDC )
326: *
327: *              W := C * V  =  (C1*V1 + C2*V2)  (stored in WORK)
328: *
329: *              W := C2
330: *
331:                DO 100 J = 1, K
332:                   CALL CCOPY( LASTC, C( 1, LASTV-K+J ), 1,
333:      $                 WORK( 1, J ), 1 )
334:   100          CONTINUE
335: *
336: *              W := W * V2
337: *
338:                CALL CTRMM( 'Right', 'Upper', 'No transpose', 'Unit',
339:      $              LASTC, K, ONE, V( LASTV-K+1, 1 ), LDV,
340:      $              WORK, LDWORK )
341:                IF( LASTV.GT.K ) THEN
342: *
343: *                 W := W + C1 * V1
344: *
345:                   CALL CGEMM( 'No transpose', 'No transpose',
346:      $                 LASTC, K, LASTV-K,
347:      $                 ONE, C, LDC, V, LDV, ONE, WORK, LDWORK )
348:                END IF
349: *
350: *              W := W * T  or  W * T'
351: *
352:                CALL CTRMM( 'Right', 'Lower', TRANS, 'Non-unit',
353:      $              LASTC, K, ONE, T, LDT, WORK, LDWORK )
354: *
355: *              C := C - W * V'
356: *
357:                IF( LASTV.GT.K ) THEN
358: *
359: *                 C1 := C1 - W * V1'
360: *
361:                   CALL CGEMM( 'No transpose', 'Conjugate transpose',
362:      $                 LASTC, LASTV-K, K, -ONE, WORK, LDWORK, V, LDV,
363:      $                 ONE, C, LDC )
364:                END IF
365: *
366: *              W := W * V2'
367: *
368:                CALL CTRMM( 'Right', 'Upper', 'Conjugate transpose',
369:      $              'Unit', LASTC, K, ONE, V( LASTV-K+1, 1 ), LDV,
370:      $              WORK, LDWORK )
371: *
372: *              C2 := C2 - W
373: *
374:                DO 120 J = 1, K
375:                   DO 110 I = 1, LASTC
376:                      C( I, LASTV-K+J ) = C( I, LASTV-K+J )
377:      $                    - WORK( I, J )
378:   110             CONTINUE
379:   120          CONTINUE
380:             END IF
381:          END IF
382: *
383:       ELSE IF( LSAME( STOREV, 'R' ) ) THEN
384: *
385:          IF( LSAME( DIRECT, 'F' ) ) THEN
386: *
387: *           Let  V =  ( V1  V2 )    (V1: first K columns)
388: *           where  V1  is unit upper triangular.
389: *
390:             IF( LSAME( SIDE, 'L' ) ) THEN
391: *
392: *              Form  H * C  or  H' * C  where  C = ( C1 )
393: *                                                  ( C2 )
394: *
395:                LASTV = MAX( K, ILACLC( K, M, V, LDV ) )
396:                LASTC = ILACLC( LASTV, N, C, LDC )
397: *
398: *              W := C' * V'  =  (C1'*V1' + C2'*V2') (stored in WORK)
399: *
400: *              W := C1'
401: *
402:                DO 130 J = 1, K
403:                   CALL CCOPY( LASTC, C( J, 1 ), LDC, WORK( 1, J ), 1 )
404:                   CALL CLACGV( LASTC, WORK( 1, J ), 1 )
405:   130          CONTINUE
406: *
407: *              W := W * V1'
408: *
409:                CALL CTRMM( 'Right', 'Upper', 'Conjugate transpose',
410:      $                     'Unit', LASTC, K, ONE, V, LDV, WORK, LDWORK )
411:                IF( LASTV.GT.K ) THEN
412: *
413: *                 W := W + C2'*V2'
414: *
415:                   CALL CGEMM( 'Conjugate transpose',
416:      $                 'Conjugate transpose', LASTC, K, LASTV-K,
417:      $                 ONE, C( K+1, 1 ), LDC, V( 1, K+1 ), LDV,
418:      $                 ONE, WORK, LDWORK )
419:                END IF
420: *
421: *              W := W * T'  or  W * T
422: *
423:                CALL CTRMM( 'Right', 'Upper', TRANST, 'Non-unit',
424:      $              LASTC, K, ONE, T, LDT, WORK, LDWORK )
425: *
426: *              C := C - V' * W'
427: *
428:                IF( LASTV.GT.K ) THEN
429: *
430: *                 C2 := C2 - V2' * W'
431: *
432:                   CALL CGEMM( 'Conjugate transpose',
433:      $                 'Conjugate transpose', LASTV-K, LASTC, K,
434:      $                 -ONE, V( 1, K+1 ), LDV, WORK, LDWORK,
435:      $                 ONE, C( K+1, 1 ), LDC )
436:                END IF
437: *
438: *              W := W * V1
439: *
440:                CALL CTRMM( 'Right', 'Upper', 'No transpose', 'Unit',
441:      $              LASTC, K, ONE, V, LDV, WORK, LDWORK )
442: *
443: *              C1 := C1 - W'
444: *
445:                DO 150 J = 1, K
446:                   DO 140 I = 1, LASTC
447:                      C( J, I ) = C( J, I ) - CONJG( WORK( I, J ) )
448:   140             CONTINUE
449:   150          CONTINUE
450: *
451:             ELSE IF( LSAME( SIDE, 'R' ) ) THEN
452: *
453: *              Form  C * H  or  C * H'  where  C = ( C1  C2 )
454: *
455:                LASTV = MAX( K, ILACLC( K, N, V, LDV ) )
456:                LASTC = ILACLR( M, LASTV, C, LDC )
457: *
458: *              W := C * V'  =  (C1*V1' + C2*V2')  (stored in WORK)
459: *
460: *              W := C1
461: *
462:                DO 160 J = 1, K
463:                   CALL CCOPY( LASTC, C( 1, J ), 1, WORK( 1, J ), 1 )
464:   160          CONTINUE
465: *
466: *              W := W * V1'
467: *
468:                CALL CTRMM( 'Right', 'Upper', 'Conjugate transpose',
469:      $                     'Unit', LASTC, K, ONE, V, LDV, WORK, LDWORK )
470:                IF( LASTV.GT.K ) THEN
471: *
472: *                 W := W + C2 * V2'
473: *
474:                   CALL CGEMM( 'No transpose', 'Conjugate transpose',
475:      $                 LASTC, K, LASTV-K, ONE, C( 1, K+1 ), LDC,
476:      $                 V( 1, K+1 ), LDV, ONE, WORK, LDWORK )
477:                END IF
478: *
479: *              W := W * T  or  W * T'
480: *
481:                CALL CTRMM( 'Right', 'Upper', TRANS, 'Non-unit',
482:      $              LASTC, K, ONE, T, LDT, WORK, LDWORK )
483: *
484: *              C := C - W * V
485: *
486:                IF( LASTV.GT.K ) THEN
487: *
488: *                 C2 := C2 - W * V2
489: *
490:                   CALL CGEMM( 'No transpose', 'No transpose',
491:      $                 LASTC, LASTV-K, K,
492:      $                 -ONE, WORK, LDWORK, V( 1, K+1 ), LDV,
493:      $                 ONE, C( 1, K+1 ), LDC )
494:                END IF
495: *
496: *              W := W * V1
497: *
498:                CALL CTRMM( 'Right', 'Upper', 'No transpose', 'Unit',
499:      $              LASTC, K, ONE, V, LDV, WORK, LDWORK )
500: *
501: *              C1 := C1 - W
502: *
503:                DO 180 J = 1, K
504:                   DO 170 I = 1, LASTC
505:                      C( I, J ) = C( I, J ) - WORK( I, J )
506:   170             CONTINUE
507:   180          CONTINUE
508: *
509:             END IF
510: *
511:          ELSE
512: *
513: *           Let  V =  ( V1  V2 )    (V2: last K columns)
514: *           where  V2  is unit lower triangular.
515: *
516:             IF( LSAME( SIDE, 'L' ) ) THEN
517: *
518: *              Form  H * C  or  H' * C  where  C = ( C1 )
519: *                                                  ( C2 )
520: *
521:                LASTV = MAX( K, ILACLC( K, M, V, LDV ) )
522:                LASTC = ILACLC( LASTV, N, C, LDC )
523: *
524: *              W := C' * V'  =  (C1'*V1' + C2'*V2') (stored in WORK)
525: *
526: *              W := C2'
527: *
528:                DO 190 J = 1, K
529:                   CALL CCOPY( LASTC, C( LASTV-K+J, 1 ), LDC,
530:      $                 WORK( 1, J ), 1 )
531:                   CALL CLACGV( LASTC, WORK( 1, J ), 1 )
532:   190          CONTINUE
533: *
534: *              W := W * V2'
535: *
536:                CALL CTRMM( 'Right', 'Lower', 'Conjugate transpose',
537:      $              'Unit', LASTC, K, ONE, V( 1, LASTV-K+1 ), LDV,
538:      $              WORK, LDWORK )
539:                IF( LASTV.GT.K ) THEN
540: *
541: *                 W := W + C1'*V1'
542: *
543:                   CALL CGEMM( 'Conjugate transpose',
544:      $                 'Conjugate transpose', LASTC, K, LASTV-K,
545:      $                 ONE, C, LDC, V, LDV, ONE, WORK, LDWORK )
546:                END IF
547: *
548: *              W := W * T'  or  W * T
549: *
550:                CALL CTRMM( 'Right', 'Lower', TRANST, 'Non-unit',
551:      $              LASTC, K, ONE, T, LDT, WORK, LDWORK )
552: *
553: *              C := C - V' * W'
554: *
555:                IF( LASTV.GT.K ) THEN
556: *
557: *                 C1 := C1 - V1' * W'
558: *
559:                   CALL CGEMM( 'Conjugate transpose',
560:      $                 'Conjugate transpose', LASTV-K, LASTC, K,
561:      $                 -ONE, V, LDV, WORK, LDWORK, ONE, C, LDC )
562:                END IF
563: *
564: *              W := W * V2
565: *
566:                CALL CTRMM( 'Right', 'Lower', 'No transpose', 'Unit',
567:      $              LASTC, K, ONE, V( 1, LASTV-K+1 ), LDV,
568:      $              WORK, LDWORK )
569: *
570: *              C2 := C2 - W'
571: *
572:                DO 210 J = 1, K
573:                   DO 200 I = 1, LASTC
574:                      C( LASTV-K+J, I ) = C( LASTV-K+J, I ) -
575:      $                               CONJG( WORK( I, J ) )
576:   200             CONTINUE
577:   210          CONTINUE
578: *
579:             ELSE IF( LSAME( SIDE, 'R' ) ) THEN
580: *
581: *              Form  C * H  or  C * H'  where  C = ( C1  C2 )
582: *
583:                LASTV = MAX( K, ILACLC( K, N, V, LDV ) )
584:                LASTC = ILACLR( M, LASTV, C, LDC )
585: *
586: *              W := C * V'  =  (C1*V1' + C2*V2')  (stored in WORK)
587: *
588: *              W := C2
589: *
590:                DO 220 J = 1, K
591:                   CALL CCOPY( LASTC, C( 1, LASTV-K+J ), 1,
592:      $                 WORK( 1, J ), 1 )
593:   220          CONTINUE
594: *
595: *              W := W * V2'
596: *
597:                CALL CTRMM( 'Right', 'Lower', 'Conjugate transpose',
598:      $              'Unit', LASTC, K, ONE, V( 1, LASTV-K+1 ), LDV,
599:      $              WORK, LDWORK )
600:                IF( LASTV.GT.K ) THEN
601: *
602: *                 W := W + C1 * V1'
603: *
604:                   CALL CGEMM( 'No transpose', 'Conjugate transpose',
605:      $                 LASTC, K, LASTV-K, ONE, C, LDC, V, LDV, ONE,
606:      $                 WORK, LDWORK )
607:                END IF
608: *
609: *              W := W * T  or  W * T'
610: *
611:                CALL CTRMM( 'Right', 'Lower', TRANS, 'Non-unit',
612:      $              LASTC, K, ONE, T, LDT, WORK, LDWORK )
613: *
614: *              C := C - W * V
615: *
616:                IF( LASTV.GT.K ) THEN
617: *
618: *                 C1 := C1 - W * V1
619: *
620:                   CALL CGEMM( 'No transpose', 'No transpose',
621:      $                 LASTC, LASTV-K, K, -ONE, WORK, LDWORK, V, LDV,
622:      $                 ONE, C, LDC )
623:                END IF
624: *
625: *              W := W * V2
626: *
627:                CALL CTRMM( 'Right', 'Lower', 'No transpose', 'Unit',
628:      $              LASTC, K, ONE, V( 1, LASTV-K+1 ), LDV,
629:      $              WORK, LDWORK )
630: *
631: *              C1 := C1 - W
632: *
633:                DO 240 J = 1, K
634:                   DO 230 I = 1, LASTC
635:                      C( I, LASTV-K+J ) = C( I, LASTV-K+J )
636:      $                    - WORK( I, J )
637:   230             CONTINUE
638:   240          CONTINUE
639: *
640:             END IF
641: *
642:          END IF
643:       END IF
644: *
645:       RETURN
646: *
647: *     End of CLARFB
648: *
649:       END
650: