1 *> \brief \b DLARFX applies an elementary reflector to a general rectangular matrix, with loop unrolling when the reflector has order ≤ 10.
3 * =========== DOCUMENTATION ===========
5 * Online html documentation available at
6 * http://www.netlib.org/lapack/explore-html/
9 *> Download DLARFX + dependencies
10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlarfx.f">
12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlarfx.f">
14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlarfx.f">
21 * SUBROUTINE DLARFX( SIDE, M, N, V, TAU, C, LDC, WORK )
23 * .. Scalar Arguments ..
26 * DOUBLE PRECISION TAU
28 * .. Array Arguments ..
29 * DOUBLE PRECISION C( LDC, * ), V( * ), WORK( * )
38 *> DLARFX applies a real elementary reflector H to a real m by n
39 *> matrix C, from either the left or the right. H is represented in the
42 *> H = I - tau * v * v**T
44 *> where tau is a real scalar and v is a real vector.
46 *> If tau = 0, then H is taken to be the unit matrix
48 *> This version uses inline code if H has order < 11.
56 *> SIDE is CHARACTER*1
64 *> The number of rows of the matrix C.
70 *> The number of columns of the matrix C.
75 *> V is DOUBLE PRECISION array, dimension (M) if SIDE = 'L'
76 *> or (N) if SIDE = 'R'
77 *> The vector v in the representation of H.
82 *> TAU is DOUBLE PRECISION
83 *> The value tau in the representation of H.
88 *> C is DOUBLE PRECISION array, dimension (LDC,N)
89 *> On entry, the m by n matrix C.
90 *> On exit, C is overwritten by the matrix H * C if SIDE = 'L',
91 *> or C * H if SIDE = 'R'.
97 *> The leading dimension of the array C. LDA >= (1,M).
102 *> WORK is DOUBLE PRECISION array, dimension
104 *> or (M) if SIDE = 'R'
105 *> WORK is not referenced if H has order < 11.
111 *> \author Univ. of Tennessee
112 *> \author Univ. of California Berkeley
113 *> \author Univ. of Colorado Denver
116 *> \date September 2012
118 *> \ingroup doubleOTHERauxiliary
120 * =====================================================================
121 SUBROUTINE DLARFX( SIDE, M, N, V, TAU, C, LDC, WORK )
123 * -- LAPACK auxiliary routine (version 3.4.2) --
124 * -- LAPACK is a software package provided by Univ. of Tennessee, --
125 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
128 * .. Scalar Arguments ..
133 * .. Array Arguments ..
134 DOUBLE PRECISION C( LDC, * ), V( * ), WORK( * )
137 * =====================================================================
140 DOUBLE PRECISION ZERO, ONE
141 PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
143 * .. Local Scalars ..
145 DOUBLE PRECISION SUM, T1, T10, T2, T3, T4, T5, T6, T7, T8, T9,
146 $ V1, V10, V2, V3, V4, V5, V6, V7, V8, V9
148 * .. External Functions ..
152 * .. External Subroutines ..
155 * .. Executable Statements ..
159 IF( LSAME( SIDE, 'L' ) ) THEN
161 * Form H * C, where H has order m.
163 GO TO ( 10, 30, 50, 70, 90, 110, 130, 150,
168 CALL DLARF( SIDE, M, N, V, 1, TAU, C, LDC, WORK )
172 * Special code for 1 x 1 Householder
174 T1 = ONE - TAU*V( 1 )*V( 1 )
176 C( 1, J ) = T1*C( 1, J )
181 * Special code for 2 x 2 Householder
188 SUM = V1*C( 1, J ) + V2*C( 2, J )
189 C( 1, J ) = C( 1, J ) - SUM*T1
190 C( 2, J ) = C( 2, J ) - SUM*T2
195 * Special code for 3 x 3 Householder
204 SUM = V1*C( 1, J ) + V2*C( 2, J ) + V3*C( 3, J )
205 C( 1, J ) = C( 1, J ) - SUM*T1
206 C( 2, J ) = C( 2, J ) - SUM*T2
207 C( 3, J ) = C( 3, J ) - SUM*T3
212 * Special code for 4 x 4 Householder
223 SUM = V1*C( 1, J ) + V2*C( 2, J ) + V3*C( 3, J ) +
225 C( 1, J ) = C( 1, J ) - SUM*T1
226 C( 2, J ) = C( 2, J ) - SUM*T2
227 C( 3, J ) = C( 3, J ) - SUM*T3
228 C( 4, J ) = C( 4, J ) - SUM*T4
233 * Special code for 5 x 5 Householder
246 SUM = V1*C( 1, J ) + V2*C( 2, J ) + V3*C( 3, J ) +
247 $ V4*C( 4, J ) + V5*C( 5, J )
248 C( 1, J ) = C( 1, J ) - SUM*T1
249 C( 2, J ) = C( 2, J ) - SUM*T2
250 C( 3, J ) = C( 3, J ) - SUM*T3
251 C( 4, J ) = C( 4, J ) - SUM*T4
252 C( 5, J ) = C( 5, J ) - SUM*T5
257 * Special code for 6 x 6 Householder
272 SUM = V1*C( 1, J ) + V2*C( 2, J ) + V3*C( 3, J ) +
273 $ V4*C( 4, J ) + V5*C( 5, J ) + V6*C( 6, J )
274 C( 1, J ) = C( 1, J ) - SUM*T1
275 C( 2, J ) = C( 2, J ) - SUM*T2
276 C( 3, J ) = C( 3, J ) - SUM*T3
277 C( 4, J ) = C( 4, J ) - SUM*T4
278 C( 5, J ) = C( 5, J ) - SUM*T5
279 C( 6, J ) = C( 6, J ) - SUM*T6
284 * Special code for 7 x 7 Householder
301 SUM = V1*C( 1, J ) + V2*C( 2, J ) + V3*C( 3, J ) +
302 $ V4*C( 4, J ) + V5*C( 5, J ) + V6*C( 6, J ) +
304 C( 1, J ) = C( 1, J ) - SUM*T1
305 C( 2, J ) = C( 2, J ) - SUM*T2
306 C( 3, J ) = C( 3, J ) - SUM*T3
307 C( 4, J ) = C( 4, J ) - SUM*T4
308 C( 5, J ) = C( 5, J ) - SUM*T5
309 C( 6, J ) = C( 6, J ) - SUM*T6
310 C( 7, J ) = C( 7, J ) - SUM*T7
315 * Special code for 8 x 8 Householder
334 SUM = V1*C( 1, J ) + V2*C( 2, J ) + V3*C( 3, J ) +
335 $ V4*C( 4, J ) + V5*C( 5, J ) + V6*C( 6, J ) +
336 $ V7*C( 7, J ) + V8*C( 8, J )
337 C( 1, J ) = C( 1, J ) - SUM*T1
338 C( 2, J ) = C( 2, J ) - SUM*T2
339 C( 3, J ) = C( 3, J ) - SUM*T3
340 C( 4, J ) = C( 4, J ) - SUM*T4
341 C( 5, J ) = C( 5, J ) - SUM*T5
342 C( 6, J ) = C( 6, J ) - SUM*T6
343 C( 7, J ) = C( 7, J ) - SUM*T7
344 C( 8, J ) = C( 8, J ) - SUM*T8
349 * Special code for 9 x 9 Householder
370 SUM = V1*C( 1, J ) + V2*C( 2, J ) + V3*C( 3, J ) +
371 $ V4*C( 4, J ) + V5*C( 5, J ) + V6*C( 6, J ) +
372 $ V7*C( 7, J ) + V8*C( 8, J ) + V9*C( 9, J )
373 C( 1, J ) = C( 1, J ) - SUM*T1
374 C( 2, J ) = C( 2, J ) - SUM*T2
375 C( 3, J ) = C( 3, J ) - SUM*T3
376 C( 4, J ) = C( 4, J ) - SUM*T4
377 C( 5, J ) = C( 5, J ) - SUM*T5
378 C( 6, J ) = C( 6, J ) - SUM*T6
379 C( 7, J ) = C( 7, J ) - SUM*T7
380 C( 8, J ) = C( 8, J ) - SUM*T8
381 C( 9, J ) = C( 9, J ) - SUM*T9
386 * Special code for 10 x 10 Householder
409 SUM = V1*C( 1, J ) + V2*C( 2, J ) + V3*C( 3, J ) +
410 $ V4*C( 4, J ) + V5*C( 5, J ) + V6*C( 6, J ) +
411 $ V7*C( 7, J ) + V8*C( 8, J ) + V9*C( 9, J ) +
413 C( 1, J ) = C( 1, J ) - SUM*T1
414 C( 2, J ) = C( 2, J ) - SUM*T2
415 C( 3, J ) = C( 3, J ) - SUM*T3
416 C( 4, J ) = C( 4, J ) - SUM*T4
417 C( 5, J ) = C( 5, J ) - SUM*T5
418 C( 6, J ) = C( 6, J ) - SUM*T6
419 C( 7, J ) = C( 7, J ) - SUM*T7
420 C( 8, J ) = C( 8, J ) - SUM*T8
421 C( 9, J ) = C( 9, J ) - SUM*T9
422 C( 10, J ) = C( 10, J ) - SUM*T10
427 * Form C * H, where H has order n.
429 GO TO ( 210, 230, 250, 270, 290, 310, 330, 350,
434 CALL DLARF( SIDE, M, N, V, 1, TAU, C, LDC, WORK )
438 * Special code for 1 x 1 Householder
440 T1 = ONE - TAU*V( 1 )*V( 1 )
442 C( J, 1 ) = T1*C( J, 1 )
447 * Special code for 2 x 2 Householder
454 SUM = V1*C( J, 1 ) + V2*C( J, 2 )
455 C( J, 1 ) = C( J, 1 ) - SUM*T1
456 C( J, 2 ) = C( J, 2 ) - SUM*T2
461 * Special code for 3 x 3 Householder
470 SUM = V1*C( J, 1 ) + V2*C( J, 2 ) + V3*C( J, 3 )
471 C( J, 1 ) = C( J, 1 ) - SUM*T1
472 C( J, 2 ) = C( J, 2 ) - SUM*T2
473 C( J, 3 ) = C( J, 3 ) - SUM*T3
478 * Special code for 4 x 4 Householder
489 SUM = V1*C( J, 1 ) + V2*C( J, 2 ) + V3*C( J, 3 ) +
491 C( J, 1 ) = C( J, 1 ) - SUM*T1
492 C( J, 2 ) = C( J, 2 ) - SUM*T2
493 C( J, 3 ) = C( J, 3 ) - SUM*T3
494 C( J, 4 ) = C( J, 4 ) - SUM*T4
499 * Special code for 5 x 5 Householder
512 SUM = V1*C( J, 1 ) + V2*C( J, 2 ) + V3*C( J, 3 ) +
513 $ V4*C( J, 4 ) + V5*C( J, 5 )
514 C( J, 1 ) = C( J, 1 ) - SUM*T1
515 C( J, 2 ) = C( J, 2 ) - SUM*T2
516 C( J, 3 ) = C( J, 3 ) - SUM*T3
517 C( J, 4 ) = C( J, 4 ) - SUM*T4
518 C( J, 5 ) = C( J, 5 ) - SUM*T5
523 * Special code for 6 x 6 Householder
538 SUM = V1*C( J, 1 ) + V2*C( J, 2 ) + V3*C( J, 3 ) +
539 $ V4*C( J, 4 ) + V5*C( J, 5 ) + V6*C( J, 6 )
540 C( J, 1 ) = C( J, 1 ) - SUM*T1
541 C( J, 2 ) = C( J, 2 ) - SUM*T2
542 C( J, 3 ) = C( J, 3 ) - SUM*T3
543 C( J, 4 ) = C( J, 4 ) - SUM*T4
544 C( J, 5 ) = C( J, 5 ) - SUM*T5
545 C( J, 6 ) = C( J, 6 ) - SUM*T6
550 * Special code for 7 x 7 Householder
567 SUM = V1*C( J, 1 ) + V2*C( J, 2 ) + V3*C( J, 3 ) +
568 $ V4*C( J, 4 ) + V5*C( J, 5 ) + V6*C( J, 6 ) +
570 C( J, 1 ) = C( J, 1 ) - SUM*T1
571 C( J, 2 ) = C( J, 2 ) - SUM*T2
572 C( J, 3 ) = C( J, 3 ) - SUM*T3
573 C( J, 4 ) = C( J, 4 ) - SUM*T4
574 C( J, 5 ) = C( J, 5 ) - SUM*T5
575 C( J, 6 ) = C( J, 6 ) - SUM*T6
576 C( J, 7 ) = C( J, 7 ) - SUM*T7
581 * Special code for 8 x 8 Householder
600 SUM = V1*C( J, 1 ) + V2*C( J, 2 ) + V3*C( J, 3 ) +
601 $ V4*C( J, 4 ) + V5*C( J, 5 ) + V6*C( J, 6 ) +
602 $ V7*C( J, 7 ) + V8*C( J, 8 )
603 C( J, 1 ) = C( J, 1 ) - SUM*T1
604 C( J, 2 ) = C( J, 2 ) - SUM*T2
605 C( J, 3 ) = C( J, 3 ) - SUM*T3
606 C( J, 4 ) = C( J, 4 ) - SUM*T4
607 C( J, 5 ) = C( J, 5 ) - SUM*T5
608 C( J, 6 ) = C( J, 6 ) - SUM*T6
609 C( J, 7 ) = C( J, 7 ) - SUM*T7
610 C( J, 8 ) = C( J, 8 ) - SUM*T8
615 * Special code for 9 x 9 Householder
636 SUM = V1*C( J, 1 ) + V2*C( J, 2 ) + V3*C( J, 3 ) +
637 $ V4*C( J, 4 ) + V5*C( J, 5 ) + V6*C( J, 6 ) +
638 $ V7*C( J, 7 ) + V8*C( J, 8 ) + V9*C( J, 9 )
639 C( J, 1 ) = C( J, 1 ) - SUM*T1
640 C( J, 2 ) = C( J, 2 ) - SUM*T2
641 C( J, 3 ) = C( J, 3 ) - SUM*T3
642 C( J, 4 ) = C( J, 4 ) - SUM*T4
643 C( J, 5 ) = C( J, 5 ) - SUM*T5
644 C( J, 6 ) = C( J, 6 ) - SUM*T6
645 C( J, 7 ) = C( J, 7 ) - SUM*T7
646 C( J, 8 ) = C( J, 8 ) - SUM*T8
647 C( J, 9 ) = C( J, 9 ) - SUM*T9
652 * Special code for 10 x 10 Householder
675 SUM = V1*C( J, 1 ) + V2*C( J, 2 ) + V3*C( J, 3 ) +
676 $ V4*C( J, 4 ) + V5*C( J, 5 ) + V6*C( J, 6 ) +
677 $ V7*C( J, 7 ) + V8*C( J, 8 ) + V9*C( J, 9 ) +
679 C( J, 1 ) = C( J, 1 ) - SUM*T1
680 C( J, 2 ) = C( J, 2 ) - SUM*T2
681 C( J, 3 ) = C( J, 3 ) - SUM*T3
682 C( J, 4 ) = C( J, 4 ) - SUM*T4
683 C( J, 5 ) = C( J, 5 ) - SUM*T5
684 C( J, 6 ) = C( J, 6 ) - SUM*T6
685 C( J, 7 ) = C( J, 7 ) - SUM*T7
686 C( J, 8 ) = C( J, 8 ) - SUM*T8
687 C( J, 9 ) = C( J, 9 ) - SUM*T9
688 C( J, 10 ) = C( J, 10 ) - SUM*T10