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