?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
LP-311 Remove basic/advanced stabilization tab auto-switch (autotune/txpid lock issues)
[librepilot.git] / ground / gcs / src / libs / eigen / lapack / zlarfb.f
blob30fc4b9407aedb3025a490959b18a5298067f6ed
1 *> \brief \b ZLARFB
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 November 2011
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.0) --
199 * -- LAPACK is a software package provided by Univ. of Tennessee, --
200 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
201 * November 2011
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 LASTV = MAX( K, ILAZLR( M, K, V, LDV ) )
386 LASTC = ILAZLC( LASTV, N, C, LDC )
387 *
388 * W := C**H * V = (C1**H * V1 + C2**H * V2) (stored in WORK)
389 *
390 * W := C2**H
391 *
392 DO 70 J = 1, K
393 CALL ZCOPY( LASTC, C( LASTV-K+J, 1 ), LDC,
394 $ WORK( 1, J ), 1 )
395 CALL ZLACGV( LASTC, WORK( 1, J ), 1 )
396 70 CONTINUE
397 *
398 * W := W * V2
399 *
400 CALL ZTRMM( 'Right', 'Upper', 'No transpose', 'Unit',
401 $ LASTC, K, ONE, V( LASTV-K+1, 1 ), LDV,
402 $ WORK, LDWORK )
403 IF( LASTV.GT.K ) THEN
404 *
405 * W := W + C1**H*V1
406 *
407 CALL ZGEMM( 'Conjugate transpose', 'No transpose',
408 $ LASTC, K, LASTV-K,
409 $ ONE, C, LDC, V, LDV,
410 $ ONE, WORK, LDWORK )
411 END IF
412 *
413 * W := W * T**H or W * T
414 *
415 CALL ZTRMM( 'Right', 'Lower', TRANST, 'Non-unit',
416 $ LASTC, K, ONE, T, LDT, WORK, LDWORK )
417 *
418 * C := C - V * W**H
419 *
420 IF( LASTV.GT.K ) THEN
421 *
422 * C1 := C1 - V1 * W**H
423 *
424 CALL ZGEMM( 'No transpose', 'Conjugate transpose',
425 $ LASTV-K, LASTC, K,
426 $ -ONE, V, LDV, WORK, LDWORK,
427 $ ONE, C, LDC )
428 END IF
429 *
430 * W := W * V2**H
431 *
432 CALL ZTRMM( 'Right', 'Upper', 'Conjugate transpose',
433 $ 'Unit', LASTC, K, ONE, V( LASTV-K+1, 1 ), LDV,
434 $ WORK, LDWORK )
435 *
436 * C2 := C2 - W**H
437 *
438 DO 90 J = 1, K
439 DO 80 I = 1, LASTC
440 C( LASTV-K+J, I ) = C( LASTV-K+J, I ) -
441 $ DCONJG( WORK( I, J ) )
442 80 CONTINUE
443 90 CONTINUE
444 *
445 ELSE IF( LSAME( SIDE, 'R' ) ) THEN
446 *
447 * Form C * H or C * H**H where C = ( C1 C2 )
448 *
449 LASTV = MAX( K, ILAZLR( N, K, V, LDV ) )
450 LASTC = ILAZLR( M, LASTV, C, LDC )
451 *
452 * W := C * V = (C1*V1 + C2*V2) (stored in WORK)
453 *
454 * W := C2
455 *
456 DO 100 J = 1, K
457 CALL ZCOPY( LASTC, C( 1, LASTV-K+J ), 1,
458 $ WORK( 1, J ), 1 )
459 100 CONTINUE
460 *
461 * W := W * V2
462 *
463 CALL ZTRMM( 'Right', 'Upper', 'No transpose', 'Unit',
464 $ LASTC, K, ONE, V( LASTV-K+1, 1 ), LDV,
465 $ WORK, LDWORK )
466 IF( LASTV.GT.K ) THEN
467 *
468 * W := W + C1 * V1
469 *
470 CALL ZGEMM( 'No transpose', 'No transpose',
471 $ LASTC, K, LASTV-K,
472 $ ONE, C, LDC, V, LDV, ONE, WORK, LDWORK )
473 END IF
474 *
475 * W := W * T or W * T**H
476 *
477 CALL ZTRMM( 'Right', 'Lower', TRANS, 'Non-unit',
478 $ LASTC, K, ONE, T, LDT, WORK, LDWORK )
479 *
480 * C := C - W * V**H
481 *
482 IF( LASTV.GT.K ) THEN
483 *
484 * C1 := C1 - W * V1**H
485 *
486 CALL ZGEMM( 'No transpose', 'Conjugate transpose',
487 $ LASTC, LASTV-K, K, -ONE, WORK, LDWORK, V, LDV,
488 $ ONE, C, LDC )
489 END IF
490 *
491 * W := W * V2**H
492 *
493 CALL ZTRMM( 'Right', 'Upper', 'Conjugate transpose',
494 $ 'Unit', LASTC, K, ONE, V( LASTV-K+1, 1 ), LDV,
495 $ WORK, LDWORK )
496 *
497 * C2 := C2 - W
498 *
499 DO 120 J = 1, K
500 DO 110 I = 1, LASTC
501 C( I, LASTV-K+J ) = C( I, LASTV-K+J )
502 $ - WORK( I, J )
503 110 CONTINUE
504 120 CONTINUE
505 END IF
506 END IF
507 *
508 ELSE IF( LSAME( STOREV, 'R' ) ) THEN
509 *
510 IF( LSAME( DIRECT, 'F' ) ) THEN
511 *
512 * Let V = ( V1 V2 ) (V1: first K columns)
513 * where V1 is unit upper triangular.
514 *
515 IF( LSAME( SIDE, 'L' ) ) THEN
516 *
517 * Form H * C or H**H * C where C = ( C1 )
518 * ( C2 )
519 *
520 LASTV = MAX( K, ILAZLC( K, M, V, LDV ) )
521 LASTC = ILAZLC( LASTV, N, C, LDC )
522 *
523 * W := C**H * V**H = (C1**H * V1**H + C2**H * V2**H) (stored in WORK)
524 *
525 * W := C1**H
526 *
527 DO 130 J = 1, K
528 CALL ZCOPY( LASTC, C( J, 1 ), LDC, WORK( 1, J ), 1 )
529 CALL ZLACGV( LASTC, WORK( 1, J ), 1 )
530 130 CONTINUE
531 *
532 * W := W * V1**H
533 *
534 CALL ZTRMM( 'Right', 'Upper', 'Conjugate transpose',
535 $ 'Unit', LASTC, K, ONE, V, LDV, WORK, LDWORK )
536 IF( LASTV.GT.K ) THEN
537 *
538 * W := W + C2**H*V2**H
539 *
540 CALL ZGEMM( 'Conjugate transpose',
541 $ 'Conjugate transpose', LASTC, K, LASTV-K,
542 $ ONE, C( K+1, 1 ), LDC, V( 1, K+1 ), LDV,
543 $ ONE, WORK, LDWORK )
544 END IF
545 *
546 * W := W * T**H or W * T
547 *
548 CALL ZTRMM( 'Right', 'Upper', TRANST, 'Non-unit',
549 $ LASTC, K, ONE, T, LDT, WORK, LDWORK )
550 *
551 * C := C - V**H * W**H
552 *
553 IF( LASTV.GT.K ) THEN
554 *
555 * C2 := C2 - V2**H * W**H
556 *
557 CALL ZGEMM( 'Conjugate transpose',
558 $ 'Conjugate transpose', LASTV-K, LASTC, K,
559 $ -ONE, V( 1, K+1 ), LDV, WORK, LDWORK,
560 $ ONE, C( K+1, 1 ), LDC )
561 END IF
562 *
563 * W := W * V1
564 *
565 CALL ZTRMM( 'Right', 'Upper', 'No transpose', 'Unit',
566 $ LASTC, K, ONE, V, LDV, WORK, LDWORK )
567 *
568 * C1 := C1 - W**H
569 *
570 DO 150 J = 1, K
571 DO 140 I = 1, LASTC
572 C( J, I ) = C( J, I ) - DCONJG( WORK( I, J ) )
573 140 CONTINUE
574 150 CONTINUE
575 *
576 ELSE IF( LSAME( SIDE, 'R' ) ) THEN
577 *
578 * Form C * H or C * H**H where C = ( C1 C2 )
579 *
580 LASTV = MAX( K, ILAZLC( K, N, V, LDV ) )
581 LASTC = ILAZLR( M, LASTV, C, LDC )
582 *
583 * W := C * V**H = (C1*V1**H + C2*V2**H) (stored in WORK)
584 *
585 * W := C1
586 *
587 DO 160 J = 1, K
588 CALL ZCOPY( LASTC, C( 1, J ), 1, WORK( 1, J ), 1 )
589 160 CONTINUE
590 *
591 * W := W * V1**H
592 *
593 CALL ZTRMM( 'Right', 'Upper', 'Conjugate transpose',
594 $ 'Unit', LASTC, K, ONE, V, LDV, WORK, LDWORK )
595 IF( LASTV.GT.K ) THEN
596 *
597 * W := W + C2 * V2**H
598 *
599 CALL ZGEMM( 'No transpose', 'Conjugate transpose',
600 $ LASTC, K, LASTV-K, ONE, C( 1, K+1 ), LDC,
601 $ V( 1, K+1 ), LDV, ONE, WORK, LDWORK )
602 END IF
603 *
604 * W := W * T or W * T**H
605 *
606 CALL ZTRMM( 'Right', 'Upper', TRANS, 'Non-unit',
607 $ LASTC, K, ONE, T, LDT, WORK, LDWORK )
608 *
609 * C := C - W * V
610 *
611 IF( LASTV.GT.K ) THEN
612 *
613 * C2 := C2 - W * V2
614 *
615 CALL ZGEMM( 'No transpose', 'No transpose',
616 $ LASTC, LASTV-K, K,
617 $ -ONE, WORK, LDWORK, V( 1, K+1 ), LDV,
618 $ ONE, C( 1, K+1 ), LDC )
619 END IF
620 *
621 * W := W * V1
622 *
623 CALL ZTRMM( 'Right', 'Upper', 'No transpose', 'Unit',
624 $ LASTC, K, ONE, V, LDV, WORK, LDWORK )
625 *
626 * C1 := C1 - W
627 *
628 DO 180 J = 1, K
629 DO 170 I = 1, LASTC
630 C( I, J ) = C( I, J ) - WORK( I, J )
631 170 CONTINUE
632 180 CONTINUE
633 *
634 END IF
635 *
636 ELSE
637 *
638 * Let V = ( V1 V2 ) (V2: last K columns)
639 * where V2 is unit lower triangular.
640 *
641 IF( LSAME( SIDE, 'L' ) ) THEN
642 *
643 * Form H * C or H**H * C where C = ( C1 )
644 * ( C2 )
645 *
646 LASTV = MAX( K, ILAZLC( K, M, V, LDV ) )
647 LASTC = ILAZLC( LASTV, N, C, LDC )
648 *
649 * W := C**H * V**H = (C1**H * V1**H + C2**H * V2**H) (stored in WORK)
650 *
651 * W := C2**H
652 *
653 DO 190 J = 1, K
654 CALL ZCOPY( LASTC, C( LASTV-K+J, 1 ), LDC,
655 $ WORK( 1, J ), 1 )
656 CALL ZLACGV( LASTC, WORK( 1, J ), 1 )
657 190 CONTINUE
658 *
659 * W := W * V2**H
660 *
661 CALL ZTRMM( 'Right', 'Lower', 'Conjugate transpose',
662 $ 'Unit', LASTC, K, ONE, V( 1, LASTV-K+1 ), LDV,
663 $ WORK, LDWORK )
664 IF( LASTV.GT.K ) THEN
665 *
666 * W := W + C1**H * V1**H
667 *
668 CALL ZGEMM( 'Conjugate transpose',
669 $ 'Conjugate transpose', LASTC, K, LASTV-K,
670 $ ONE, C, LDC, V, LDV, ONE, WORK, LDWORK )
671 END IF
672 *
673 * W := W * T**H or W * T
674 *
675 CALL ZTRMM( 'Right', 'Lower', TRANST, 'Non-unit',
676 $ LASTC, K, ONE, T, LDT, WORK, LDWORK )
677 *
678 * C := C - V**H * W**H
679 *
680 IF( LASTV.GT.K ) THEN
681 *
682 * C1 := C1 - V1**H * W**H
683 *
684 CALL ZGEMM( 'Conjugate transpose',
685 $ 'Conjugate transpose', LASTV-K, LASTC, K,
686 $ -ONE, V, LDV, WORK, LDWORK, ONE, C, LDC )
687 END IF
688 *
689 * W := W * V2
690 *
691 CALL ZTRMM( 'Right', 'Lower', 'No transpose', 'Unit',
692 $ LASTC, K, ONE, V( 1, LASTV-K+1 ), LDV,
693 $ WORK, LDWORK )
694 *
695 * C2 := C2 - W**H
696 *
697 DO 210 J = 1, K
698 DO 200 I = 1, LASTC
699 C( LASTV-K+J, I ) = C( LASTV-K+J, I ) -
700 $ DCONJG( WORK( I, J ) )
701 200 CONTINUE
702 210 CONTINUE
703 *
704 ELSE IF( LSAME( SIDE, 'R' ) ) THEN
705 *
706 * Form C * H or C * H**H where C = ( C1 C2 )
707 *
708 LASTV = MAX( K, ILAZLC( K, N, V, LDV ) )
709 LASTC = ILAZLR( M, LASTV, C, LDC )
710 *
711 * W := C * V**H = (C1*V1**H + C2*V2**H) (stored in WORK)
712 *
713 * W := C2
714 *
715 DO 220 J = 1, K
716 CALL ZCOPY( LASTC, C( 1, LASTV-K+J ), 1,
717 $ WORK( 1, J ), 1 )
718 220 CONTINUE
719 *
720 * W := W * V2**H
721 *
722 CALL ZTRMM( 'Right', 'Lower', 'Conjugate transpose',
723 $ 'Unit', LASTC, K, ONE, V( 1, LASTV-K+1 ), LDV,
724 $ WORK, LDWORK )
725 IF( LASTV.GT.K ) THEN
726 *
727 * W := W + C1 * V1**H
728 *
729 CALL ZGEMM( 'No transpose', 'Conjugate transpose',
730 $ LASTC, K, LASTV-K, ONE, C, LDC, V, LDV, ONE,
731 $ WORK, LDWORK )
732 END IF
733 *
734 * W := W * T or W * T**H
735 *
736 CALL ZTRMM( 'Right', 'Lower', TRANS, 'Non-unit',
737 $ LASTC, K, ONE, T, LDT, WORK, LDWORK )
738 *
739 * C := C - W * V
740 *
741 IF( LASTV.GT.K ) THEN
742 *
743 * C1 := C1 - W * V1
744 *
745 CALL ZGEMM( 'No transpose', 'No transpose',
746 $ LASTC, LASTV-K, K, -ONE, WORK, LDWORK, V, LDV,
747 $ ONE, C, LDC )
748 END IF
749 *
750 * W := W * V2
751 *
752 CALL ZTRMM( 'Right', 'Lower', 'No transpose', 'Unit',
753 $ LASTC, K, ONE, V( 1, LASTV-K+1 ), LDV,
754 $ WORK, LDWORK )
755 *
756 * C1 := C1 - W
757 *
758 DO 240 J = 1, K
759 DO 230 I = 1, LASTC
760 C( I, LASTV-K+J ) = C( I, LASTV-K+J )
761 $ - WORK( I, J )
762 230 CONTINUE
763 240 CONTINUE
764 *
765 END IF
766 *
767 END IF
768 END IF
769 *
770 RETURN
771 *
772 * End of ZLARFB
773 *
774 END