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 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