LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
dlarfx.f
Go to the documentation of this file.
1*> \brief \b DLARFX applies an elementary reflector to a general rectangular matrix, with loop unrolling when the reflector has order ≤ 10.
2*
3* =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6* http://www.netlib.org/lapack/explore-html/
7*
8*> \htmlonly
9*> Download DLARFX + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlarfx.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlarfx.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlarfx.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18* Definition:
19* ===========
20*
21* SUBROUTINE DLARFX( SIDE, M, N, V, TAU, C, LDC, WORK )
22*
23* .. Scalar Arguments ..
24* CHARACTER SIDE
25* INTEGER LDC, M, N
26* DOUBLE PRECISION TAU
27* ..
28* .. Array Arguments ..
29* DOUBLE PRECISION C( LDC, * ), V( * ), WORK( * )
30* ..
31*
32*
33*> \par Purpose:
34* =============
35*>
36*> \verbatim
37*>
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
40*> form
41*>
42*> H = I - tau * v * v**T
43*>
44*> where tau is a real scalar and v is a real vector.
45*>
46*> If tau = 0, then H is taken to be the unit matrix
47*>
48*> This version uses inline code if H has order < 11.
49*> \endverbatim
50*
51* Arguments:
52* ==========
53*
54*> \param[in] SIDE
55*> \verbatim
56*> SIDE is CHARACTER*1
57*> = 'L': form H * C
58*> = 'R': form C * H
59*> \endverbatim
60*>
61*> \param[in] M
62*> \verbatim
63*> M is INTEGER
64*> The number of rows of the matrix C.
65*> \endverbatim
66*>
67*> \param[in] N
68*> \verbatim
69*> N is INTEGER
70*> The number of columns of the matrix C.
71*> \endverbatim
72*>
73*> \param[in] V
74*> \verbatim
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.
78*> \endverbatim
79*>
80*> \param[in] TAU
81*> \verbatim
82*> TAU is DOUBLE PRECISION
83*> The value tau in the representation of H.
84*> \endverbatim
85*>
86*> \param[in,out] C
87*> \verbatim
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'.
92*> \endverbatim
93*>
94*> \param[in] LDC
95*> \verbatim
96*> LDC is INTEGER
97*> The leading dimension of the array C. LDC >= (1,M).
98*> \endverbatim
99*>
100*> \param[out] WORK
101*> \verbatim
102*> WORK is DOUBLE PRECISION array, dimension
103*> (N) if SIDE = 'L'
104*> or (M) if SIDE = 'R'
105*> WORK is not referenced if H has order < 11.
106*> \endverbatim
107*
108* Authors:
109* ========
110*
111*> \author Univ. of Tennessee
112*> \author Univ. of California Berkeley
113*> \author Univ. of Colorado Denver
114*> \author NAG Ltd.
115*
116*> \ingroup larfx
117*
118* =====================================================================
119 SUBROUTINE dlarfx( SIDE, M, N, V, TAU, C, LDC, WORK )
120*
121* -- LAPACK auxiliary routine --
122* -- LAPACK is a software package provided by Univ. of Tennessee, --
123* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
124*
125* .. Scalar Arguments ..
126 CHARACTER SIDE
127 INTEGER LDC, M, N
128 DOUBLE PRECISION TAU
129* ..
130* .. Array Arguments ..
131 DOUBLE PRECISION C( LDC, * ), V( * ), WORK( * )
132* ..
133*
134* =====================================================================
135*
136* .. Parameters ..
137 DOUBLE PRECISION ZERO, ONE
138 parameter( zero = 0.0d+0, one = 1.0d+0 )
139* ..
140* .. Local Scalars ..
141 INTEGER J
142 DOUBLE PRECISION SUM, T1, T10, T2, T3, T4, T5, T6, T7, T8, T9,
143 $ V1, V10, V2, V3, V4, V5, V6, V7, V8, V9
144* ..
145* .. External Functions ..
146 LOGICAL LSAME
147 EXTERNAL lsame
148* ..
149* .. External Subroutines ..
150 EXTERNAL dlarf
151* ..
152* .. Executable Statements ..
153*
154 IF( tau.EQ.zero )
155 $ RETURN
156 IF( lsame( side, 'L' ) ) THEN
157*
158* Form H * C, where H has order m.
159*
160 GO TO ( 10, 30, 50, 70, 90, 110, 130, 150,
161 $ 170, 190 )m
162*
163* Code for general M
164*
165 CALL dlarf( side, m, n, v, 1, tau, c, ldc, work )
166 GO TO 410
167 10 CONTINUE
168*
169* Special code for 1 x 1 Householder
170*
171 t1 = one - tau*v( 1 )*v( 1 )
172 DO 20 j = 1, n
173 c( 1, j ) = t1*c( 1, j )
174 20 CONTINUE
175 GO TO 410
176 30 CONTINUE
177*
178* Special code for 2 x 2 Householder
179*
180 v1 = v( 1 )
181 t1 = tau*v1
182 v2 = v( 2 )
183 t2 = tau*v2
184 DO 40 j = 1, n
185 sum = v1*c( 1, j ) + v2*c( 2, j )
186 c( 1, j ) = c( 1, j ) - sum*t1
187 c( 2, j ) = c( 2, j ) - sum*t2
188 40 CONTINUE
189 GO TO 410
190 50 CONTINUE
191*
192* Special code for 3 x 3 Householder
193*
194 v1 = v( 1 )
195 t1 = tau*v1
196 v2 = v( 2 )
197 t2 = tau*v2
198 v3 = v( 3 )
199 t3 = tau*v3
200 DO 60 j = 1, n
201 sum = v1*c( 1, j ) + v2*c( 2, j ) + v3*c( 3, j )
202 c( 1, j ) = c( 1, j ) - sum*t1
203 c( 2, j ) = c( 2, j ) - sum*t2
204 c( 3, j ) = c( 3, j ) - sum*t3
205 60 CONTINUE
206 GO TO 410
207 70 CONTINUE
208*
209* Special code for 4 x 4 Householder
210*
211 v1 = v( 1 )
212 t1 = tau*v1
213 v2 = v( 2 )
214 t2 = tau*v2
215 v3 = v( 3 )
216 t3 = tau*v3
217 v4 = v( 4 )
218 t4 = tau*v4
219 DO 80 j = 1, n
220 sum = v1*c( 1, j ) + v2*c( 2, j ) + v3*c( 3, j ) +
221 $ v4*c( 4, j )
222 c( 1, j ) = c( 1, j ) - sum*t1
223 c( 2, j ) = c( 2, j ) - sum*t2
224 c( 3, j ) = c( 3, j ) - sum*t3
225 c( 4, j ) = c( 4, j ) - sum*t4
226 80 CONTINUE
227 GO TO 410
228 90 CONTINUE
229*
230* Special code for 5 x 5 Householder
231*
232 v1 = v( 1 )
233 t1 = tau*v1
234 v2 = v( 2 )
235 t2 = tau*v2
236 v3 = v( 3 )
237 t3 = tau*v3
238 v4 = v( 4 )
239 t4 = tau*v4
240 v5 = v( 5 )
241 t5 = tau*v5
242 DO 100 j = 1, n
243 sum = v1*c( 1, j ) + v2*c( 2, j ) + v3*c( 3, j ) +
244 $ v4*c( 4, j ) + v5*c( 5, j )
245 c( 1, j ) = c( 1, j ) - sum*t1
246 c( 2, j ) = c( 2, j ) - sum*t2
247 c( 3, j ) = c( 3, j ) - sum*t3
248 c( 4, j ) = c( 4, j ) - sum*t4
249 c( 5, j ) = c( 5, j ) - sum*t5
250 100 CONTINUE
251 GO TO 410
252 110 CONTINUE
253*
254* Special code for 6 x 6 Householder
255*
256 v1 = v( 1 )
257 t1 = tau*v1
258 v2 = v( 2 )
259 t2 = tau*v2
260 v3 = v( 3 )
261 t3 = tau*v3
262 v4 = v( 4 )
263 t4 = tau*v4
264 v5 = v( 5 )
265 t5 = tau*v5
266 v6 = v( 6 )
267 t6 = tau*v6
268 DO 120 j = 1, n
269 sum = v1*c( 1, j ) + v2*c( 2, j ) + v3*c( 3, j ) +
270 $ v4*c( 4, j ) + v5*c( 5, j ) + v6*c( 6, j )
271 c( 1, j ) = c( 1, j ) - sum*t1
272 c( 2, j ) = c( 2, j ) - sum*t2
273 c( 3, j ) = c( 3, j ) - sum*t3
274 c( 4, j ) = c( 4, j ) - sum*t4
275 c( 5, j ) = c( 5, j ) - sum*t5
276 c( 6, j ) = c( 6, j ) - sum*t6
277 120 CONTINUE
278 GO TO 410
279 130 CONTINUE
280*
281* Special code for 7 x 7 Householder
282*
283 v1 = v( 1 )
284 t1 = tau*v1
285 v2 = v( 2 )
286 t2 = tau*v2
287 v3 = v( 3 )
288 t3 = tau*v3
289 v4 = v( 4 )
290 t4 = tau*v4
291 v5 = v( 5 )
292 t5 = tau*v5
293 v6 = v( 6 )
294 t6 = tau*v6
295 v7 = v( 7 )
296 t7 = tau*v7
297 DO 140 j = 1, n
298 sum = v1*c( 1, j ) + v2*c( 2, j ) + v3*c( 3, j ) +
299 $ v4*c( 4, j ) + v5*c( 5, j ) + v6*c( 6, j ) +
300 $ v7*c( 7, j )
301 c( 1, j ) = c( 1, j ) - sum*t1
302 c( 2, j ) = c( 2, j ) - sum*t2
303 c( 3, j ) = c( 3, j ) - sum*t3
304 c( 4, j ) = c( 4, j ) - sum*t4
305 c( 5, j ) = c( 5, j ) - sum*t5
306 c( 6, j ) = c( 6, j ) - sum*t6
307 c( 7, j ) = c( 7, j ) - sum*t7
308 140 CONTINUE
309 GO TO 410
310 150 CONTINUE
311*
312* Special code for 8 x 8 Householder
313*
314 v1 = v( 1 )
315 t1 = tau*v1
316 v2 = v( 2 )
317 t2 = tau*v2
318 v3 = v( 3 )
319 t3 = tau*v3
320 v4 = v( 4 )
321 t4 = tau*v4
322 v5 = v( 5 )
323 t5 = tau*v5
324 v6 = v( 6 )
325 t6 = tau*v6
326 v7 = v( 7 )
327 t7 = tau*v7
328 v8 = v( 8 )
329 t8 = tau*v8
330 DO 160 j = 1, n
331 sum = v1*c( 1, j ) + v2*c( 2, j ) + v3*c( 3, j ) +
332 $ v4*c( 4, j ) + v5*c( 5, j ) + v6*c( 6, j ) +
333 $ v7*c( 7, j ) + v8*c( 8, j )
334 c( 1, j ) = c( 1, j ) - sum*t1
335 c( 2, j ) = c( 2, j ) - sum*t2
336 c( 3, j ) = c( 3, j ) - sum*t3
337 c( 4, j ) = c( 4, j ) - sum*t4
338 c( 5, j ) = c( 5, j ) - sum*t5
339 c( 6, j ) = c( 6, j ) - sum*t6
340 c( 7, j ) = c( 7, j ) - sum*t7
341 c( 8, j ) = c( 8, j ) - sum*t8
342 160 CONTINUE
343 GO TO 410
344 170 CONTINUE
345*
346* Special code for 9 x 9 Householder
347*
348 v1 = v( 1 )
349 t1 = tau*v1
350 v2 = v( 2 )
351 t2 = tau*v2
352 v3 = v( 3 )
353 t3 = tau*v3
354 v4 = v( 4 )
355 t4 = tau*v4
356 v5 = v( 5 )
357 t5 = tau*v5
358 v6 = v( 6 )
359 t6 = tau*v6
360 v7 = v( 7 )
361 t7 = tau*v7
362 v8 = v( 8 )
363 t8 = tau*v8
364 v9 = v( 9 )
365 t9 = tau*v9
366 DO 180 j = 1, n
367 sum = v1*c( 1, j ) + v2*c( 2, j ) + v3*c( 3, j ) +
368 $ v4*c( 4, j ) + v5*c( 5, j ) + v6*c( 6, j ) +
369 $ v7*c( 7, j ) + v8*c( 8, j ) + v9*c( 9, j )
370 c( 1, j ) = c( 1, j ) - sum*t1
371 c( 2, j ) = c( 2, j ) - sum*t2
372 c( 3, j ) = c( 3, j ) - sum*t3
373 c( 4, j ) = c( 4, j ) - sum*t4
374 c( 5, j ) = c( 5, j ) - sum*t5
375 c( 6, j ) = c( 6, j ) - sum*t6
376 c( 7, j ) = c( 7, j ) - sum*t7
377 c( 8, j ) = c( 8, j ) - sum*t8
378 c( 9, j ) = c( 9, j ) - sum*t9
379 180 CONTINUE
380 GO TO 410
381 190 CONTINUE
382*
383* Special code for 10 x 10 Householder
384*
385 v1 = v( 1 )
386 t1 = tau*v1
387 v2 = v( 2 )
388 t2 = tau*v2
389 v3 = v( 3 )
390 t3 = tau*v3
391 v4 = v( 4 )
392 t4 = tau*v4
393 v5 = v( 5 )
394 t5 = tau*v5
395 v6 = v( 6 )
396 t6 = tau*v6
397 v7 = v( 7 )
398 t7 = tau*v7
399 v8 = v( 8 )
400 t8 = tau*v8
401 v9 = v( 9 )
402 t9 = tau*v9
403 v10 = v( 10 )
404 t10 = tau*v10
405 DO 200 j = 1, n
406 sum = v1*c( 1, j ) + v2*c( 2, j ) + v3*c( 3, j ) +
407 $ v4*c( 4, j ) + v5*c( 5, j ) + v6*c( 6, j ) +
408 $ v7*c( 7, j ) + v8*c( 8, j ) + v9*c( 9, j ) +
409 $ v10*c( 10, j )
410 c( 1, j ) = c( 1, j ) - sum*t1
411 c( 2, j ) = c( 2, j ) - sum*t2
412 c( 3, j ) = c( 3, j ) - sum*t3
413 c( 4, j ) = c( 4, j ) - sum*t4
414 c( 5, j ) = c( 5, j ) - sum*t5
415 c( 6, j ) = c( 6, j ) - sum*t6
416 c( 7, j ) = c( 7, j ) - sum*t7
417 c( 8, j ) = c( 8, j ) - sum*t8
418 c( 9, j ) = c( 9, j ) - sum*t9
419 c( 10, j ) = c( 10, j ) - sum*t10
420 200 CONTINUE
421 GO TO 410
422 ELSE
423*
424* Form C * H, where H has order n.
425*
426 GO TO ( 210, 230, 250, 270, 290, 310, 330, 350,
427 $ 370, 390 )n
428*
429* Code for general N
430*
431 CALL dlarf( side, m, n, v, 1, tau, c, ldc, work )
432 GO TO 410
433 210 CONTINUE
434*
435* Special code for 1 x 1 Householder
436*
437 t1 = one - tau*v( 1 )*v( 1 )
438 DO 220 j = 1, m
439 c( j, 1 ) = t1*c( j, 1 )
440 220 CONTINUE
441 GO TO 410
442 230 CONTINUE
443*
444* Special code for 2 x 2 Householder
445*
446 v1 = v( 1 )
447 t1 = tau*v1
448 v2 = v( 2 )
449 t2 = tau*v2
450 DO 240 j = 1, m
451 sum = v1*c( j, 1 ) + v2*c( j, 2 )
452 c( j, 1 ) = c( j, 1 ) - sum*t1
453 c( j, 2 ) = c( j, 2 ) - sum*t2
454 240 CONTINUE
455 GO TO 410
456 250 CONTINUE
457*
458* Special code for 3 x 3 Householder
459*
460 v1 = v( 1 )
461 t1 = tau*v1
462 v2 = v( 2 )
463 t2 = tau*v2
464 v3 = v( 3 )
465 t3 = tau*v3
466 DO 260 j = 1, m
467 sum = v1*c( j, 1 ) + v2*c( j, 2 ) + v3*c( j, 3 )
468 c( j, 1 ) = c( j, 1 ) - sum*t1
469 c( j, 2 ) = c( j, 2 ) - sum*t2
470 c( j, 3 ) = c( j, 3 ) - sum*t3
471 260 CONTINUE
472 GO TO 410
473 270 CONTINUE
474*
475* Special code for 4 x 4 Householder
476*
477 v1 = v( 1 )
478 t1 = tau*v1
479 v2 = v( 2 )
480 t2 = tau*v2
481 v3 = v( 3 )
482 t3 = tau*v3
483 v4 = v( 4 )
484 t4 = tau*v4
485 DO 280 j = 1, m
486 sum = v1*c( j, 1 ) + v2*c( j, 2 ) + v3*c( j, 3 ) +
487 $ v4*c( j, 4 )
488 c( j, 1 ) = c( j, 1 ) - sum*t1
489 c( j, 2 ) = c( j, 2 ) - sum*t2
490 c( j, 3 ) = c( j, 3 ) - sum*t3
491 c( j, 4 ) = c( j, 4 ) - sum*t4
492 280 CONTINUE
493 GO TO 410
494 290 CONTINUE
495*
496* Special code for 5 x 5 Householder
497*
498 v1 = v( 1 )
499 t1 = tau*v1
500 v2 = v( 2 )
501 t2 = tau*v2
502 v3 = v( 3 )
503 t3 = tau*v3
504 v4 = v( 4 )
505 t4 = tau*v4
506 v5 = v( 5 )
507 t5 = tau*v5
508 DO 300 j = 1, m
509 sum = v1*c( j, 1 ) + v2*c( j, 2 ) + v3*c( j, 3 ) +
510 $ v4*c( j, 4 ) + v5*c( j, 5 )
511 c( j, 1 ) = c( j, 1 ) - sum*t1
512 c( j, 2 ) = c( j, 2 ) - sum*t2
513 c( j, 3 ) = c( j, 3 ) - sum*t3
514 c( j, 4 ) = c( j, 4 ) - sum*t4
515 c( j, 5 ) = c( j, 5 ) - sum*t5
516 300 CONTINUE
517 GO TO 410
518 310 CONTINUE
519*
520* Special code for 6 x 6 Householder
521*
522 v1 = v( 1 )
523 t1 = tau*v1
524 v2 = v( 2 )
525 t2 = tau*v2
526 v3 = v( 3 )
527 t3 = tau*v3
528 v4 = v( 4 )
529 t4 = tau*v4
530 v5 = v( 5 )
531 t5 = tau*v5
532 v6 = v( 6 )
533 t6 = tau*v6
534 DO 320 j = 1, m
535 sum = v1*c( j, 1 ) + v2*c( j, 2 ) + v3*c( j, 3 ) +
536 $ v4*c( j, 4 ) + v5*c( j, 5 ) + v6*c( j, 6 )
537 c( j, 1 ) = c( j, 1 ) - sum*t1
538 c( j, 2 ) = c( j, 2 ) - sum*t2
539 c( j, 3 ) = c( j, 3 ) - sum*t3
540 c( j, 4 ) = c( j, 4 ) - sum*t4
541 c( j, 5 ) = c( j, 5 ) - sum*t5
542 c( j, 6 ) = c( j, 6 ) - sum*t6
543 320 CONTINUE
544 GO TO 410
545 330 CONTINUE
546*
547* Special code for 7 x 7 Householder
548*
549 v1 = v( 1 )
550 t1 = tau*v1
551 v2 = v( 2 )
552 t2 = tau*v2
553 v3 = v( 3 )
554 t3 = tau*v3
555 v4 = v( 4 )
556 t4 = tau*v4
557 v5 = v( 5 )
558 t5 = tau*v5
559 v6 = v( 6 )
560 t6 = tau*v6
561 v7 = v( 7 )
562 t7 = tau*v7
563 DO 340 j = 1, m
564 sum = v1*c( j, 1 ) + v2*c( j, 2 ) + v3*c( j, 3 ) +
565 $ v4*c( j, 4 ) + v5*c( j, 5 ) + v6*c( j, 6 ) +
566 $ v7*c( j, 7 )
567 c( j, 1 ) = c( j, 1 ) - sum*t1
568 c( j, 2 ) = c( j, 2 ) - sum*t2
569 c( j, 3 ) = c( j, 3 ) - sum*t3
570 c( j, 4 ) = c( j, 4 ) - sum*t4
571 c( j, 5 ) = c( j, 5 ) - sum*t5
572 c( j, 6 ) = c( j, 6 ) - sum*t6
573 c( j, 7 ) = c( j, 7 ) - sum*t7
574 340 CONTINUE
575 GO TO 410
576 350 CONTINUE
577*
578* Special code for 8 x 8 Householder
579*
580 v1 = v( 1 )
581 t1 = tau*v1
582 v2 = v( 2 )
583 t2 = tau*v2
584 v3 = v( 3 )
585 t3 = tau*v3
586 v4 = v( 4 )
587 t4 = tau*v4
588 v5 = v( 5 )
589 t5 = tau*v5
590 v6 = v( 6 )
591 t6 = tau*v6
592 v7 = v( 7 )
593 t7 = tau*v7
594 v8 = v( 8 )
595 t8 = tau*v8
596 DO 360 j = 1, m
597 sum = v1*c( j, 1 ) + v2*c( j, 2 ) + v3*c( j, 3 ) +
598 $ v4*c( j, 4 ) + v5*c( j, 5 ) + v6*c( j, 6 ) +
599 $ v7*c( j, 7 ) + v8*c( j, 8 )
600 c( j, 1 ) = c( j, 1 ) - sum*t1
601 c( j, 2 ) = c( j, 2 ) - sum*t2
602 c( j, 3 ) = c( j, 3 ) - sum*t3
603 c( j, 4 ) = c( j, 4 ) - sum*t4
604 c( j, 5 ) = c( j, 5 ) - sum*t5
605 c( j, 6 ) = c( j, 6 ) - sum*t6
606 c( j, 7 ) = c( j, 7 ) - sum*t7
607 c( j, 8 ) = c( j, 8 ) - sum*t8
608 360 CONTINUE
609 GO TO 410
610 370 CONTINUE
611*
612* Special code for 9 x 9 Householder
613*
614 v1 = v( 1 )
615 t1 = tau*v1
616 v2 = v( 2 )
617 t2 = tau*v2
618 v3 = v( 3 )
619 t3 = tau*v3
620 v4 = v( 4 )
621 t4 = tau*v4
622 v5 = v( 5 )
623 t5 = tau*v5
624 v6 = v( 6 )
625 t6 = tau*v6
626 v7 = v( 7 )
627 t7 = tau*v7
628 v8 = v( 8 )
629 t8 = tau*v8
630 v9 = v( 9 )
631 t9 = tau*v9
632 DO 380 j = 1, m
633 sum = v1*c( j, 1 ) + v2*c( j, 2 ) + v3*c( j, 3 ) +
634 $ v4*c( j, 4 ) + v5*c( j, 5 ) + v6*c( j, 6 ) +
635 $ v7*c( j, 7 ) + v8*c( j, 8 ) + v9*c( j, 9 )
636 c( j, 1 ) = c( j, 1 ) - sum*t1
637 c( j, 2 ) = c( j, 2 ) - sum*t2
638 c( j, 3 ) = c( j, 3 ) - sum*t3
639 c( j, 4 ) = c( j, 4 ) - sum*t4
640 c( j, 5 ) = c( j, 5 ) - sum*t5
641 c( j, 6 ) = c( j, 6 ) - sum*t6
642 c( j, 7 ) = c( j, 7 ) - sum*t7
643 c( j, 8 ) = c( j, 8 ) - sum*t8
644 c( j, 9 ) = c( j, 9 ) - sum*t9
645 380 CONTINUE
646 GO TO 410
647 390 CONTINUE
648*
649* Special code for 10 x 10 Householder
650*
651 v1 = v( 1 )
652 t1 = tau*v1
653 v2 = v( 2 )
654 t2 = tau*v2
655 v3 = v( 3 )
656 t3 = tau*v3
657 v4 = v( 4 )
658 t4 = tau*v4
659 v5 = v( 5 )
660 t5 = tau*v5
661 v6 = v( 6 )
662 t6 = tau*v6
663 v7 = v( 7 )
664 t7 = tau*v7
665 v8 = v( 8 )
666 t8 = tau*v8
667 v9 = v( 9 )
668 t9 = tau*v9
669 v10 = v( 10 )
670 t10 = tau*v10
671 DO 400 j = 1, m
672 sum = v1*c( j, 1 ) + v2*c( j, 2 ) + v3*c( j, 3 ) +
673 $ v4*c( j, 4 ) + v5*c( j, 5 ) + v6*c( j, 6 ) +
674 $ v7*c( j, 7 ) + v8*c( j, 8 ) + v9*c( j, 9 ) +
675 $ v10*c( j, 10 )
676 c( j, 1 ) = c( j, 1 ) - sum*t1
677 c( j, 2 ) = c( j, 2 ) - sum*t2
678 c( j, 3 ) = c( j, 3 ) - sum*t3
679 c( j, 4 ) = c( j, 4 ) - sum*t4
680 c( j, 5 ) = c( j, 5 ) - sum*t5
681 c( j, 6 ) = c( j, 6 ) - sum*t6
682 c( j, 7 ) = c( j, 7 ) - sum*t7
683 c( j, 8 ) = c( j, 8 ) - sum*t8
684 c( j, 9 ) = c( j, 9 ) - sum*t9
685 c( j, 10 ) = c( j, 10 ) - sum*t10
686 400 CONTINUE
687 GO TO 410
688 END IF
689 410 CONTINUE
690 RETURN
691*
692* End of DLARFX
693*
694 END
subroutine dlarf(side, m, n, v, incv, tau, c, ldc, work)
DLARF applies an elementary reflector to a general rectangular matrix.
Definition dlarf.f:124
subroutine dlarfx(side, m, n, v, tau, c, ldc, work)
DLARFX applies an elementary reflector to a general rectangular matrix, with loop unrolling when the ...
Definition dlarfx.f:120