LAPACK  3.4.2
LAPACK: Linear Algebra PACKage
 All Files Functions Groups
zlarfb.f
Go to the documentation of this file.
1 *> \brief \b ZLARFB applies a block reflector or its conjugate-transpose to a general rectangular matrix.
2 *
3 * =========== DOCUMENTATION ===========
4 *
5 * Online html documentation available at
6 * http://www.netlib.org/lapack/explore-html/
7 *
8 *> \htmlonly
9 *> Download ZLARFB + dependencies
10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zlarfb.f">
11 *> [TGZ]</a>
12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zlarfb.f">
13 *> [ZIP]</a>
14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zlarfb.f">
15 *> [TXT]</a>
16 *> \endhtmlonly
17 *
18 * Definition:
19 * ===========
20 *
21 * SUBROUTINE ZLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV,
22 * T, LDT, C, LDC, WORK, LDWORK )
23 *
24 * .. Scalar Arguments ..
25 * CHARACTER DIRECT, SIDE, STOREV, TRANS
26 * INTEGER K, LDC, LDT, LDV, LDWORK, M, N
27 * ..
28 * .. Array Arguments ..
29 * COMPLEX*16 C( LDC, * ), T( LDT, * ), V( LDV, * ),
30 * $ WORK( LDWORK, * )
31 * ..
32 *
33 *
34 *> \par Purpose:
35 * =============
36 *>
37 *> \verbatim
38 *>
39 *> ZLARFB applies a complex block reflector H or its transpose H**H to a
40 *> complex M-by-N matrix C, from either the left or the right.
41 *> \endverbatim
42 *
43 * Arguments:
44 * ==========
45 *
46 *> \param[in] SIDE
47 *> \verbatim
48 *> SIDE is CHARACTER*1
49 *> = 'L': apply H or H**H from the Left
50 *> = 'R': apply H or H**H from the Right
51 *> \endverbatim
52 *>
53 *> \param[in] TRANS
54 *> \verbatim
55 *> TRANS is CHARACTER*1
56 *> = 'N': apply H (No transpose)
57 *> = 'C': apply H**H (Conjugate transpose)
58 *> \endverbatim
59 *>
60 *> \param[in] DIRECT
61 *> \verbatim
62 *> DIRECT is CHARACTER*1
63 *> Indicates how H is formed from a product of elementary
64 *> reflectors
65 *> = 'F': H = H(1) H(2) . . . H(k) (Forward)
66 *> = 'B': H = H(k) . . . H(2) H(1) (Backward)
67 *> \endverbatim
68 *>
69 *> \param[in] STOREV
70 *> \verbatim
71 *> STOREV is CHARACTER*1
72 *> Indicates how the vectors which define the elementary
73 *> reflectors are stored:
74 *> = 'C': Columnwise
75 *> = 'R': Rowwise
76 *> \endverbatim
77 *>
78 *> \param[in] M
79 *> \verbatim
80 *> M is INTEGER
81 *> The number of rows of the matrix C.
82 *> \endverbatim
83 *>
84 *> \param[in] N
85 *> \verbatim
86 *> N is INTEGER
87 *> The number of columns of the matrix C.
88 *> \endverbatim
89 *>
90 *> \param[in] K
91 *> \verbatim
92 *> K is INTEGER
93 *> The order of the matrix T (= the number of elementary
94 *> reflectors whose product defines the block reflector).
95 *> \endverbatim
96 *>
97 *> \param[in] V
98 *> \verbatim
99 *> V is COMPLEX*16 array, dimension
100 *> (LDV,K) if STOREV = 'C'
101 *> (LDV,M) if STOREV = 'R' and SIDE = 'L'
102 *> (LDV,N) if STOREV = 'R' and SIDE = 'R'
103 *> See Further Details.
104 *> \endverbatim
105 *>
106 *> \param[in] LDV
107 *> \verbatim
108 *> LDV is INTEGER
109 *> The leading dimension of the array V.
110 *> If STOREV = 'C' and SIDE = 'L', LDV >= max(1,M);
111 *> if STOREV = 'C' and SIDE = 'R', LDV >= max(1,N);
112 *> if STOREV = 'R', LDV >= K.
113 *> \endverbatim
114 *>
115 *> \param[in] T
116 *> \verbatim
117 *> T is COMPLEX*16 array, dimension (LDT,K)
118 *> The triangular K-by-K matrix T in the representation of the
119 *> block reflector.
120 *> \endverbatim
121 *>
122 *> \param[in] LDT
123 *> \verbatim
124 *> LDT is INTEGER
125 *> The leading dimension of the array T. LDT >= K.
126 *> \endverbatim
127 *>
128 *> \param[in,out] C
129 *> \verbatim
130 *> C is COMPLEX*16 array, dimension (LDC,N)
131 *> On entry, the M-by-N matrix C.
132 *> On exit, C is overwritten by H*C or H**H*C or C*H or C*H**H.
133 *> \endverbatim
134 *>
135 *> \param[in] LDC
136 *> \verbatim
137 *> LDC is INTEGER
138 *> The leading dimension of the array C. LDC >= max(1,M).
139 *> \endverbatim
140 *>
141 *> \param[out] WORK
142 *> \verbatim
143 *> WORK is COMPLEX*16 array, dimension (LDWORK,K)
144 *> \endverbatim
145 *>
146 *> \param[in] LDWORK
147 *> \verbatim
148 *> LDWORK is INTEGER
149 *> The leading dimension of the array WORK.
150 *> If SIDE = 'L', LDWORK >= max(1,N);
151 *> if SIDE = 'R', LDWORK >= max(1,M).
152 *> \endverbatim
153 *
154 * Authors:
155 * ========
156 *
157 *> \author Univ. of Tennessee
158 *> \author Univ. of California Berkeley
159 *> \author Univ. of Colorado Denver
160 *> \author NAG Ltd.
161 *
162 *> \date September 2012
163 *
164 *> \ingroup complex16OTHERauxiliary
165 *
166 *> \par Further Details:
167 * =====================
168 *>
169 *> \verbatim
170 *>
171 *> The shape of the matrix V and the storage of the vectors which define
172 *> the H(i) is best illustrated by the following example with n = 5 and
173 *> k = 3. The elements equal to 1 are not stored; the corresponding
174 *> array elements are modified but restored on exit. The rest of the
175 *> array is not used.
176 *>
177 *> DIRECT = 'F' and STOREV = 'C': DIRECT = 'F' and STOREV = 'R':
178 *>
179 *> V = ( 1 ) V = ( 1 v1 v1 v1 v1 )
180 *> ( v1 1 ) ( 1 v2 v2 v2 )
181 *> ( v1 v2 1 ) ( 1 v3 v3 )
182 *> ( v1 v2 v3 )
183 *> ( v1 v2 v3 )
184 *>
185 *> DIRECT = 'B' and STOREV = 'C': DIRECT = 'B' and STOREV = 'R':
186 *>
187 *> V = ( v1 v2 v3 ) V = ( v1 v1 1 )
188 *> ( v1 v2 v3 ) ( v2 v2 v2 1 )
189 *> ( 1 v2 v3 ) ( v3 v3 v3 v3 1 )
190 *> ( 1 v3 )
191 *> ( 1 )
192 *> \endverbatim
193 *>
194 * =====================================================================
195  SUBROUTINE zlarfb( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV,
196  $ t, ldt, c, ldc, work, ldwork )
197 *
198 * -- LAPACK auxiliary routine (version 3.4.2) --
199 * -- LAPACK is a software package provided by Univ. of Tennessee, --
200 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
201 * September 2012
202 *
203 * .. Scalar Arguments ..
204  CHARACTER direct, side, storev, trans
205  INTEGER k, ldc, ldt, ldv, ldwork, m, n
206 * ..
207 * .. Array Arguments ..
208  COMPLEX*16 c( ldc, * ), t( ldt, * ), v( ldv, * ),
209  $ work( ldwork, * )
210 * ..
211 *
212 * =====================================================================
213 *
214 * .. Parameters ..
215  COMPLEX*16 one
216  parameter( one = ( 1.0d+0, 0.0d+0 ) )
217 * ..
218 * .. Local Scalars ..
219  CHARACTER transt
220  INTEGER i, j, lastv, lastc
221 * ..
222 * .. External Functions ..
223  LOGICAL lsame
224  INTEGER ilazlr, ilazlc
225  EXTERNAL lsame, ilazlr, ilazlc
226 * ..
227 * .. External Subroutines ..
228  EXTERNAL zcopy, zgemm, zlacgv, ztrmm
229 * ..
230 * .. Intrinsic Functions ..
231  INTRINSIC dconjg
232 * ..
233 * .. Executable Statements ..
234 *
235 * Quick return if possible
236 *
237  IF( m.LE.0 .OR. n.LE.0 )
238  $ return
239 *
240  IF( lsame( trans, 'N' ) ) THEN
241  transt = 'C'
242  ELSE
243  transt = 'N'
244  END IF
245 *
246  IF( lsame( storev, 'C' ) ) THEN
247 *
248  IF( lsame( direct, 'F' ) ) THEN
249 *
250 * Let V = ( V1 ) (first K rows)
251 * ( V2 )
252 * where V1 is unit lower triangular.
253 *
254  IF( lsame( side, 'L' ) ) THEN
255 *
256 * Form H * C or H**H * C where C = ( C1 )
257 * ( C2 )
258 *
259  lastv = max( k, ilazlr( m, k, v, ldv ) )
260  lastc = ilazlc( lastv, n, c, ldc )
261 *
262 * W := C**H * V = (C1**H * V1 + C2**H * V2) (stored in WORK)
263 *
264 * W := C1**H
265 *
266  DO 10 j = 1, k
267  CALL zcopy( lastc, c( j, 1 ), ldc, work( 1, j ), 1 )
268  CALL zlacgv( lastc, work( 1, j ), 1 )
269  10 continue
270 *
271 * W := W * V1
272 *
273  CALL ztrmm( 'Right', 'Lower', 'No transpose', 'Unit',
274  $ lastc, k, one, v, ldv, work, ldwork )
275  IF( lastv.GT.k ) THEN
276 *
277 * W := W + C2**H *V2
278 *
279  CALL zgemm( 'Conjugate transpose', 'No transpose',
280  $ lastc, k, lastv-k, one, c( k+1, 1 ), ldc,
281  $ v( k+1, 1 ), ldv, one, work, ldwork )
282  END IF
283 *
284 * W := W * T**H or W * T
285 *
286  CALL ztrmm( 'Right', 'Upper', transt, 'Non-unit',
287  $ lastc, k, one, t, ldt, work, ldwork )
288 *
289 * C := C - V * W**H
290 *
291  IF( m.GT.k ) THEN
292 *
293 * C2 := C2 - V2 * W**H
294 *
295  CALL zgemm( 'No transpose', 'Conjugate transpose',
296  $ lastv-k, lastc, k,
297  $ -one, v( k+1, 1 ), ldv, work, ldwork,
298  $ one, c( k+1, 1 ), ldc )
299  END IF
300 *
301 * W := W * V1**H
302 *
303  CALL ztrmm( 'Right', 'Lower', 'Conjugate transpose',
304  $ 'Unit', lastc, k, one, v, ldv, work, ldwork )
305 *
306 * C1 := C1 - W**H
307 *
308  DO 30 j = 1, k
309  DO 20 i = 1, lastc
310  c( j, i ) = c( j, i ) - dconjg( work( i, j ) )
311  20 continue
312  30 continue
313 *
314  ELSE IF( lsame( side, 'R' ) ) THEN
315 *
316 * Form C * H or C * H**H where C = ( C1 C2 )
317 *
318  lastv = max( k, ilazlr( n, k, v, ldv ) )
319  lastc = ilazlr( m, lastv, c, ldc )
320 *
321 * W := C * V = (C1*V1 + C2*V2) (stored in WORK)
322 *
323 * W := C1
324 *
325  DO 40 j = 1, k
326  CALL zcopy( lastc, c( 1, j ), 1, work( 1, j ), 1 )
327  40 continue
328 *
329 * W := W * V1
330 *
331  CALL ztrmm( 'Right', 'Lower', 'No transpose', 'Unit',
332  $ lastc, k, one, v, ldv, work, ldwork )
333  IF( lastv.GT.k ) THEN
334 *
335 * W := W + C2 * V2
336 *
337  CALL zgemm( 'No transpose', 'No transpose',
338  $ lastc, k, lastv-k,
339  $ one, c( 1, k+1 ), ldc, v( k+1, 1 ), ldv,
340  $ one, work, ldwork )
341  END IF
342 *
343 * W := W * T or W * T**H
344 *
345  CALL ztrmm( 'Right', 'Upper', trans, 'Non-unit',
346  $ lastc, k, one, t, ldt, work, ldwork )
347 *
348 * C := C - W * V**H
349 *
350  IF( lastv.GT.k ) THEN
351 *
352 * C2 := C2 - W * V2**H
353 *
354  CALL zgemm( 'No transpose', 'Conjugate transpose',
355  $ lastc, lastv-k, k,
356  $ -one, work, ldwork, v( k+1, 1 ), ldv,
357  $ one, c( 1, k+1 ), ldc )
358  END IF
359 *
360 * W := W * V1**H
361 *
362  CALL ztrmm( 'Right', 'Lower', 'Conjugate transpose',
363  $ 'Unit', lastc, k, one, v, ldv, work, ldwork )
364 *
365 * C1 := C1 - W
366 *
367  DO 60 j = 1, k
368  DO 50 i = 1, lastc
369  c( i, j ) = c( i, j ) - work( i, j )
370  50 continue
371  60 continue
372  END IF
373 *
374  ELSE
375 *
376 * Let V = ( V1 )
377 * ( V2 ) (last K rows)
378 * where V2 is unit upper triangular.
379 *
380  IF( lsame( side, 'L' ) ) THEN
381 *
382 * Form H * C or H**H * C where C = ( C1 )
383 * ( C2 )
384 *
385  lastc = ilazlc( m, n, c, ldc )
386 *
387 * W := C**H * V = (C1**H * V1 + C2**H * V2) (stored in WORK)
388 *
389 * W := C2**H
390 *
391  DO 70 j = 1, k
392  CALL zcopy( lastc, c( m-k+j, 1 ), ldc,
393  $ work( 1, j ), 1 )
394  CALL zlacgv( lastc, work( 1, j ), 1 )
395  70 continue
396 *
397 * W := W * V2
398 *
399  CALL ztrmm( 'Right', 'Upper', 'No transpose', 'Unit',
400  $ lastc, k, one, v( m-k+1, 1 ), ldv,
401  $ work, ldwork )
402  IF( m.GT.k ) THEN
403 *
404 * W := W + C1**H*V1
405 *
406  CALL zgemm( 'Conjugate transpose', 'No transpose',
407  $ lastc, k, m-k,
408  $ one, c, ldc, v, ldv,
409  $ one, work, ldwork )
410  END IF
411 *
412 * W := W * T**H or W * T
413 *
414  CALL ztrmm( 'Right', 'Lower', transt, 'Non-unit',
415  $ lastc, k, one, t, ldt, work, ldwork )
416 *
417 * C := C - V * W**H
418 *
419  IF( m.GT.k ) THEN
420 *
421 * C1 := C1 - V1 * W**H
422 *
423  CALL zgemm( 'No transpose', 'Conjugate transpose',
424  $ m-k, lastc, k,
425  $ -one, v, ldv, work, ldwork,
426  $ one, c, ldc )
427  END IF
428 *
429 * W := W * V2**H
430 *
431  CALL ztrmm( 'Right', 'Upper', 'Conjugate transpose',
432  $ 'Unit', lastc, k, one, v( m-k+1, 1 ), ldv,
433  $ work, ldwork )
434 *
435 * C2 := C2 - W**H
436 *
437  DO 90 j = 1, k
438  DO 80 i = 1, lastc
439  c( m-k+j, i ) = c( m-k+j, i ) -
440  $ dconjg( work( i, j ) )
441  80 continue
442  90 continue
443 *
444  ELSE IF( lsame( side, 'R' ) ) THEN
445 *
446 * Form C * H or C * H**H where C = ( C1 C2 )
447 *
448  lastc = ilazlr( m, n, c, ldc )
449 *
450 * W := C * V = (C1*V1 + C2*V2) (stored in WORK)
451 *
452 * W := C2
453 *
454  DO 100 j = 1, k
455  CALL zcopy( lastc, c( 1, n-k+j ), 1,
456  $ work( 1, j ), 1 )
457  100 continue
458 *
459 * W := W * V2
460 *
461  CALL ztrmm( 'Right', 'Upper', 'No transpose', 'Unit',
462  $ lastc, k, one, v( n-k+1, 1 ), ldv,
463  $ work, ldwork )
464  IF( n.GT.k ) THEN
465 *
466 * W := W + C1 * V1
467 *
468  CALL zgemm( 'No transpose', 'No transpose',
469  $ lastc, k, n-k,
470  $ one, c, ldc, v, ldv, one, work, ldwork )
471  END IF
472 *
473 * W := W * T or W * T**H
474 *
475  CALL ztrmm( 'Right', 'Lower', trans, 'Non-unit',
476  $ lastc, k, one, t, ldt, work, ldwork )
477 *
478 * C := C - W * V**H
479 *
480  IF( n.GT.k ) THEN
481 *
482 * C1 := C1 - W * V1**H
483 *
484  CALL zgemm( 'No transpose', 'Conjugate transpose',
485  $ lastc, n-k, k, -one, work, ldwork, v, ldv,
486  $ one, c, ldc )
487  END IF
488 *
489 * W := W * V2**H
490 *
491  CALL ztrmm( 'Right', 'Upper', 'Conjugate transpose',
492  $ 'Unit', lastc, k, one, v( n-k+1, 1 ), ldv,
493  $ work, ldwork )
494 *
495 * C2 := C2 - W
496 *
497  DO 120 j = 1, k
498  DO 110 i = 1, lastc
499  c( i, n-k+j ) = c( i, n-k+j )
500  $ - work( i, j )
501  110 continue
502  120 continue
503  END IF
504  END IF
505 *
506  ELSE IF( lsame( storev, 'R' ) ) THEN
507 *
508  IF( lsame( direct, 'F' ) ) THEN
509 *
510 * Let V = ( V1 V2 ) (V1: first K columns)
511 * where V1 is unit upper triangular.
512 *
513  IF( lsame( side, 'L' ) ) THEN
514 *
515 * Form H * C or H**H * C where C = ( C1 )
516 * ( C2 )
517 *
518  lastv = max( k, ilazlc( k, m, v, ldv ) )
519  lastc = ilazlc( lastv, n, c, ldc )
520 *
521 * W := C**H * V**H = (C1**H * V1**H + C2**H * V2**H) (stored in WORK)
522 *
523 * W := C1**H
524 *
525  DO 130 j = 1, k
526  CALL zcopy( lastc, c( j, 1 ), ldc, work( 1, j ), 1 )
527  CALL zlacgv( lastc, work( 1, j ), 1 )
528  130 continue
529 *
530 * W := W * V1**H
531 *
532  CALL ztrmm( 'Right', 'Upper', 'Conjugate transpose',
533  $ 'Unit', lastc, k, one, v, ldv, work, ldwork )
534  IF( lastv.GT.k ) THEN
535 *
536 * W := W + C2**H*V2**H
537 *
538  CALL zgemm( 'Conjugate transpose',
539  $ 'Conjugate transpose', lastc, k, lastv-k,
540  $ one, c( k+1, 1 ), ldc, v( 1, k+1 ), ldv,
541  $ one, work, ldwork )
542  END IF
543 *
544 * W := W * T**H or W * T
545 *
546  CALL ztrmm( 'Right', 'Upper', transt, 'Non-unit',
547  $ lastc, k, one, t, ldt, work, ldwork )
548 *
549 * C := C - V**H * W**H
550 *
551  IF( lastv.GT.k ) THEN
552 *
553 * C2 := C2 - V2**H * W**H
554 *
555  CALL zgemm( 'Conjugate transpose',
556  $ 'Conjugate transpose', lastv-k, lastc, k,
557  $ -one, v( 1, k+1 ), ldv, work, ldwork,
558  $ one, c( k+1, 1 ), ldc )
559  END IF
560 *
561 * W := W * V1
562 *
563  CALL ztrmm( 'Right', 'Upper', 'No transpose', 'Unit',
564  $ lastc, k, one, v, ldv, work, ldwork )
565 *
566 * C1 := C1 - W**H
567 *
568  DO 150 j = 1, k
569  DO 140 i = 1, lastc
570  c( j, i ) = c( j, i ) - dconjg( work( i, j ) )
571  140 continue
572  150 continue
573 *
574  ELSE IF( lsame( side, 'R' ) ) THEN
575 *
576 * Form C * H or C * H**H where C = ( C1 C2 )
577 *
578  lastv = max( k, ilazlc( k, n, v, ldv ) )
579  lastc = ilazlr( m, lastv, c, ldc )
580 *
581 * W := C * V**H = (C1*V1**H + C2*V2**H) (stored in WORK)
582 *
583 * W := C1
584 *
585  DO 160 j = 1, k
586  CALL zcopy( lastc, c( 1, j ), 1, work( 1, j ), 1 )
587  160 continue
588 *
589 * W := W * V1**H
590 *
591  CALL ztrmm( 'Right', 'Upper', 'Conjugate transpose',
592  $ 'Unit', lastc, k, one, v, ldv, work, ldwork )
593  IF( lastv.GT.k ) THEN
594 *
595 * W := W + C2 * V2**H
596 *
597  CALL zgemm( 'No transpose', 'Conjugate transpose',
598  $ lastc, k, lastv-k, one, c( 1, k+1 ), ldc,
599  $ v( 1, k+1 ), ldv, one, work, ldwork )
600  END IF
601 *
602 * W := W * T or W * T**H
603 *
604  CALL ztrmm( 'Right', 'Upper', trans, 'Non-unit',
605  $ lastc, k, one, t, ldt, work, ldwork )
606 *
607 * C := C - W * V
608 *
609  IF( lastv.GT.k ) THEN
610 *
611 * C2 := C2 - W * V2
612 *
613  CALL zgemm( 'No transpose', 'No transpose',
614  $ lastc, lastv-k, k,
615  $ -one, work, ldwork, v( 1, k+1 ), ldv,
616  $ one, c( 1, k+1 ), ldc )
617  END IF
618 *
619 * W := W * V1
620 *
621  CALL ztrmm( 'Right', 'Upper', 'No transpose', 'Unit',
622  $ lastc, k, one, v, ldv, work, ldwork )
623 *
624 * C1 := C1 - W
625 *
626  DO 180 j = 1, k
627  DO 170 i = 1, lastc
628  c( i, j ) = c( i, j ) - work( i, j )
629  170 continue
630  180 continue
631 *
632  END IF
633 *
634  ELSE
635 *
636 * Let V = ( V1 V2 ) (V2: last K columns)
637 * where V2 is unit lower triangular.
638 *
639  IF( lsame( side, 'L' ) ) THEN
640 *
641 * Form H * C or H**H * C where C = ( C1 )
642 * ( C2 )
643 *
644  lastc = ilazlc( m, n, c, ldc )
645 *
646 * W := C**H * V**H = (C1**H * V1**H + C2**H * V2**H) (stored in WORK)
647 *
648 * W := C2**H
649 *
650  DO 190 j = 1, k
651  CALL zcopy( lastc, c( m-k+j, 1 ), ldc,
652  $ work( 1, j ), 1 )
653  CALL zlacgv( lastc, work( 1, j ), 1 )
654  190 continue
655 *
656 * W := W * V2**H
657 *
658  CALL ztrmm( 'Right', 'Lower', 'Conjugate transpose',
659  $ 'Unit', lastc, k, one, v( 1, m-k+1 ), ldv,
660  $ work, ldwork )
661  IF( m.GT.k ) THEN
662 *
663 * W := W + C1**H * V1**H
664 *
665  CALL zgemm( 'Conjugate transpose',
666  $ 'Conjugate transpose', lastc, k, m-k,
667  $ one, c, ldc, v, ldv, one, work, ldwork )
668  END IF
669 *
670 * W := W * T**H or W * T
671 *
672  CALL ztrmm( 'Right', 'Lower', transt, 'Non-unit',
673  $ lastc, k, one, t, ldt, work, ldwork )
674 *
675 * C := C - V**H * W**H
676 *
677  IF( m.GT.k ) THEN
678 *
679 * C1 := C1 - V1**H * W**H
680 *
681  CALL zgemm( 'Conjugate transpose',
682  $ 'Conjugate transpose', m-k, lastc, k,
683  $ -one, v, ldv, work, ldwork, one, c, ldc )
684  END IF
685 *
686 * W := W * V2
687 *
688  CALL ztrmm( 'Right', 'Lower', 'No transpose', 'Unit',
689  $ lastc, k, one, v( 1, m-k+1 ), ldv,
690  $ work, ldwork )
691 *
692 * C2 := C2 - W**H
693 *
694  DO 210 j = 1, k
695  DO 200 i = 1, lastc
696  c( m-k+j, i ) = c( m-k+j, i ) -
697  $ dconjg( work( i, j ) )
698  200 continue
699  210 continue
700 *
701  ELSE IF( lsame( side, 'R' ) ) THEN
702 *
703 * Form C * H or C * H**H where C = ( C1 C2 )
704 *
705  lastc = ilazlr( m, n, c, ldc )
706 *
707 * W := C * V**H = (C1*V1**H + C2*V2**H) (stored in WORK)
708 *
709 * W := C2
710 *
711  DO 220 j = 1, k
712  CALL zcopy( lastc, c( 1, n-k+j ), 1,
713  $ work( 1, j ), 1 )
714  220 continue
715 *
716 * W := W * V2**H
717 *
718  CALL ztrmm( 'Right', 'Lower', 'Conjugate transpose',
719  $ 'Unit', lastc, k, one, v( 1, n-k+1 ), ldv,
720  $ work, ldwork )
721  IF( n.GT.k ) THEN
722 *
723 * W := W + C1 * V1**H
724 *
725  CALL zgemm( 'No transpose', 'Conjugate transpose',
726  $ lastc, k, n-k, one, c, ldc, v, ldv, one,
727  $ work, ldwork )
728  END IF
729 *
730 * W := W * T or W * T**H
731 *
732  CALL ztrmm( 'Right', 'Lower', trans, 'Non-unit',
733  $ lastc, k, one, t, ldt, work, ldwork )
734 *
735 * C := C - W * V
736 *
737  IF( n.GT.k ) THEN
738 *
739 * C1 := C1 - W * V1
740 *
741  CALL zgemm( 'No transpose', 'No transpose',
742  $ lastc, n-k, k, -one, work, ldwork, v, ldv,
743  $ one, c, ldc )
744  END IF
745 *
746 * W := W * V2
747 *
748  CALL ztrmm( 'Right', 'Lower', 'No transpose', 'Unit',
749  $ lastc, k, one, v( 1, n-k+1 ), ldv,
750  $ work, ldwork )
751 *
752 * C1 := C1 - W
753 *
754  DO 240 j = 1, k
755  DO 230 i = 1, lastc
756  c( i, n-k+j ) = c( i, n-k+j ) - work( i, j )
757  230 continue
758  240 continue
759 *
760  END IF
761 *
762  END IF
763  END IF
764 *
765  return
766 *
767 * End of ZLARFB
768 *
769  END