![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to zlarfb.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / lapack / lapack|
Return to zlarfb.f CVS log | Up to [local] / rpl / lapack / lapack |
1.1 bertrand 1: SUBROUTINE ZLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV,
2: $ T, LDT, C, LDC, WORK, LDWORK )
3: IMPLICIT NONE
4: *
5: * -- LAPACK auxiliary routine (version 3.2) --
6: * -- LAPACK is a software package provided by Univ. of Tennessee, --
7: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
8: * November 2006
9: *
10: * .. Scalar Arguments ..
11: CHARACTER DIRECT, SIDE, STOREV, TRANS
12: INTEGER K, LDC, LDT, LDV, LDWORK, M, N
13: * ..
14: * .. Array Arguments ..
15: COMPLEX*16 C( LDC, * ), T( LDT, * ), V( LDV, * ),
16: $ WORK( LDWORK, * )
17: * ..
18: *
19: * Purpose
20: * =======
21: *
22: * ZLARFB applies a complex block reflector H or its transpose H' to a
23: * complex M-by-N matrix C, from either the left or the right.
24: *
25: * Arguments
26: * =========
27: *
28: * SIDE (input) CHARACTER*1
29: * = 'L': apply H or H' from the Left
30: * = 'R': apply H or H' from the Right
31: *
32: * TRANS (input) CHARACTER*1
33: * = 'N': apply H (No transpose)
34: * = 'C': apply H' (Conjugate transpose)
35: *
36: * DIRECT (input) CHARACTER*1
37: * Indicates how H is formed from a product of elementary
38: * reflectors
39: * = 'F': H = H(1) H(2) . . . H(k) (Forward)
40: * = 'B': H = H(k) . . . H(2) H(1) (Backward)
41: *
42: * STOREV (input) CHARACTER*1
43: * Indicates how the vectors which define the elementary
44: * reflectors are stored:
45: * = 'C': Columnwise
46: * = 'R': Rowwise
47: *
48: * M (input) INTEGER
49: * The number of rows of the matrix C.
50: *
51: * N (input) INTEGER
52: * The number of columns of the matrix C.
53: *
54: * K (input) INTEGER
55: * The order of the matrix T (= the number of elementary
56: * reflectors whose product defines the block reflector).
57: *
58: * V (input) COMPLEX*16 array, dimension
59: * (LDV,K) if STOREV = 'C'
60: * (LDV,M) if STOREV = 'R' and SIDE = 'L'
61: * (LDV,N) if STOREV = 'R' and SIDE = 'R'
62: * The matrix V. See further details.
63: *
64: * LDV (input) INTEGER
65: * The leading dimension of the array V.
66: * If STOREV = 'C' and SIDE = 'L', LDV >= max(1,M);
67: * if STOREV = 'C' and SIDE = 'R', LDV >= max(1,N);
68: * if STOREV = 'R', LDV >= K.
69: *
70: * T (input) COMPLEX*16 array, dimension (LDT,K)
71: * The triangular K-by-K matrix T in the representation of the
72: * block reflector.
73: *
74: * LDT (input) INTEGER
75: * The leading dimension of the array T. LDT >= K.
76: *
77: * C (input/output) COMPLEX*16 array, dimension (LDC,N)
78: * On entry, the M-by-N matrix C.
79: * On exit, C is overwritten by H*C or H'*C or C*H or C*H'.
80: *
81: * LDC (input) INTEGER
82: * The leading dimension of the array C. LDC >= max(1,M).
83: *
84: * WORK (workspace) COMPLEX*16 array, dimension (LDWORK,K)
85: *
86: * LDWORK (input) INTEGER
87: * The leading dimension of the array WORK.
88: * If SIDE = 'L', LDWORK >= max(1,N);
89: * if SIDE = 'R', LDWORK >= max(1,M).
90: *
91: * =====================================================================
92: *
93: * .. Parameters ..
94: COMPLEX*16 ONE
95: PARAMETER ( ONE = ( 1.0D+0, 0.0D+0 ) )
96: * ..
97: * .. Local Scalars ..
98: CHARACTER TRANST
99: 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