120
121
122
123
124
125
126 CHARACTER SIDE
127 INTEGER LDC, M, N
128 REAL TAU
129
130
131 REAL C( LDC, * ), V( * ), WORK( * )
132
133
134
135
136
137 REAL ZERO, ONE
138 parameter( zero = 0.0e+0, one = 1.0e+0 )
139
140
141 INTEGER J
142 REAL SUM, T1, T10, T2, T3, T4, T5, T6, T7, T8, T9,
143 $ V1, V10, V2, V3, V4, V5, V6, V7, V8, V9
144
145
146 LOGICAL LSAME
148
149
151
152
153
154 IF( tau.EQ.zero )
155 $ RETURN
156 IF(
lsame( side,
'L' ) )
THEN
157
158
159
160 GO TO ( 10, 30, 50, 70, 90, 110, 130, 150,
161 $ 170, 190 )m
162
163
164
165 CALL slarf( side, m, n, v, 1, tau, c, ldc, work )
166 GO TO 410
167 10 CONTINUE
168
169
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
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
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
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
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
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
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
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
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
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
425
426 GO TO ( 210, 230, 250, 270, 290, 310, 330, 350,
427 $ 370, 390 )n
428
429
430
431 CALL slarf( side, m, n, v, 1, tau, c, ldc, work )
432 GO TO 410
433 210 CONTINUE
434
435
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
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
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
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
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
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
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
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
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
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 RETURN
690
691
692
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