121 SUBROUTINE slarfx( SIDE, M, N, V, TAU, C, LDC, WORK )
134 REAL c( ldc, * ), v( * ), work( * )
141 parameter( zero = 0.0e+0, one = 1.0e+0 )
145 REAL sum, t1, t10, t2, t3, t4, t5, t6, t7, t8, t9,
146 $ v1, v10, v2, v3, v4, v5, v6, v7, v8, v9
159 IF(
lsame( side,
'L' ) )
THEN
163 go to( 10, 30, 50, 70, 90, 110, 130, 150,
168 CALL
slarf( side, m, n, v, 1, tau, c, ldc, work )
174 t1 = one - tau*v( 1 )*v( 1 )
176 c( 1,
j ) = t1*c( 1,
j )
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
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
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
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
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
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
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
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
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
429 go to( 210, 230, 250, 270, 290, 310, 330, 350,
434 CALL
slarf( side, m, n, v, 1, tau, c, ldc, work )
440 t1 = one - tau*v( 1 )*v( 1 )
442 c(
j, 1 ) = t1*c(
j, 1 )
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
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
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
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
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
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
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
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
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
subroutine slarfx(SIDE, M, N, V, TAU, C, LDC, WORK)
SLARFX applies an elementary reflector to a general rectangular matrix, with loop unrolling when the ...
subroutine slarf(SIDE, M, N, V, INCV, TAU, C, LDC, WORK)
SLARF applies an elementary reflector to a general rectangular matrix.
logical function lsame(CA, CB)
LSAME
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j