117
118
119
120
121
122
123 CHARACTER SIDE
124 INTEGER LDC, M, N
125 COMPLEX TAU
126
127
128 COMPLEX C( LDC, * ), V( * ), WORK( * )
129
130
131
132
133
134 COMPLEX ZERO, ONE
135 parameter( zero = ( 0.0e+0, 0.0e+0 ),
136 $ one = ( 1.0e+0, 0.0e+0 ) )
137
138
139 INTEGER J
140 COMPLEX SUM, T1, T10, T2, T3, T4, T5, T6, T7, T8, T9,
141 $ V1, V10, V2, V3, V4, V5, V6, V7, V8, V9
142
143
144 LOGICAL LSAME
146
147
149
150
151 INTRINSIC conjg
152
153
154
155 IF( tau.EQ.zero )
156 $ RETURN
157 IF(
lsame( side,
'L' ) )
THEN
158
159
160
161 GO TO ( 10, 30, 50, 70, 90, 110, 130, 150,
162 $ 170, 190 )m
163
164
165
166 CALL clarf( side, m, n, v, 1, tau, c, ldc, work )
167 GO TO 410
168 10 CONTINUE
169
170
171
172 t1 = one - tau*v( 1 )*conjg( v( 1 ) )
173 DO 20 j = 1, n
174 c( 1, j ) = t1*c( 1, j )
175 20 CONTINUE
176 GO TO 410
177 30 CONTINUE
178
179
180
181 v1 = conjg( v( 1 ) )
182 t1 = tau*conjg( v1 )
183 v2 = conjg( v( 2 ) )
184 t2 = tau*conjg( v2 )
185 DO 40 j = 1, n
186 sum = v1*c( 1, j ) + v2*c( 2, j )
187 c( 1, j ) = c( 1, j ) - sum*t1
188 c( 2, j ) = c( 2, j ) - sum*t2
189 40 CONTINUE
190 GO TO 410
191 50 CONTINUE
192
193
194
195 v1 = conjg( v( 1 ) )
196 t1 = tau*conjg( v1 )
197 v2 = conjg( v( 2 ) )
198 t2 = tau*conjg( v2 )
199 v3 = conjg( v( 3 ) )
200 t3 = tau*conjg( v3 )
201 DO 60 j = 1, n
202 sum = v1*c( 1, j ) + v2*c( 2, j ) + v3*c( 3, j )
203 c( 1, j ) = c( 1, j ) - sum*t1
204 c( 2, j ) = c( 2, j ) - sum*t2
205 c( 3, j ) = c( 3, j ) - sum*t3
206 60 CONTINUE
207 GO TO 410
208 70 CONTINUE
209
210
211
212 v1 = conjg( v( 1 ) )
213 t1 = tau*conjg( v1 )
214 v2 = conjg( v( 2 ) )
215 t2 = tau*conjg( v2 )
216 v3 = conjg( v( 3 ) )
217 t3 = tau*conjg( v3 )
218 v4 = conjg( v( 4 ) )
219 t4 = tau*conjg( v4 )
220 DO 80 j = 1, n
221 sum = v1*c( 1, j ) + v2*c( 2, j ) + v3*c( 3, j ) +
222 $ v4*c( 4, j )
223 c( 1, j ) = c( 1, j ) - sum*t1
224 c( 2, j ) = c( 2, j ) - sum*t2
225 c( 3, j ) = c( 3, j ) - sum*t3
226 c( 4, j ) = c( 4, j ) - sum*t4
227 80 CONTINUE
228 GO TO 410
229 90 CONTINUE
230
231
232
233 v1 = conjg( v( 1 ) )
234 t1 = tau*conjg( v1 )
235 v2 = conjg( v( 2 ) )
236 t2 = tau*conjg( v2 )
237 v3 = conjg( v( 3 ) )
238 t3 = tau*conjg( v3 )
239 v4 = conjg( v( 4 ) )
240 t4 = tau*conjg( v4 )
241 v5 = conjg( v( 5 ) )
242 t5 = tau*conjg( v5 )
243 DO 100 j = 1, n
244 sum = v1*c( 1, j ) + v2*c( 2, j ) + v3*c( 3, j ) +
245 $ v4*c( 4, j ) + v5*c( 5, j )
246 c( 1, j ) = c( 1, j ) - sum*t1
247 c( 2, j ) = c( 2, j ) - sum*t2
248 c( 3, j ) = c( 3, j ) - sum*t3
249 c( 4, j ) = c( 4, j ) - sum*t4
250 c( 5, j ) = c( 5, j ) - sum*t5
251 100 CONTINUE
252 GO TO 410
253 110 CONTINUE
254
255
256
257 v1 = conjg( v( 1 ) )
258 t1 = tau*conjg( v1 )
259 v2 = conjg( v( 2 ) )
260 t2 = tau*conjg( v2 )
261 v3 = conjg( v( 3 ) )
262 t3 = tau*conjg( v3 )
263 v4 = conjg( v( 4 ) )
264 t4 = tau*conjg( v4 )
265 v5 = conjg( v( 5 ) )
266 t5 = tau*conjg( v5 )
267 v6 = conjg( v( 6 ) )
268 t6 = tau*conjg( v6 )
269 DO 120 j = 1, n
270 sum = v1*c( 1, j ) + v2*c( 2, j ) + v3*c( 3, j ) +
271 $ v4*c( 4, j ) + v5*c( 5, j ) + v6*c( 6, j )
272 c( 1, j ) = c( 1, j ) - sum*t1
273 c( 2, j ) = c( 2, j ) - sum*t2
274 c( 3, j ) = c( 3, j ) - sum*t3
275 c( 4, j ) = c( 4, j ) - sum*t4
276 c( 5, j ) = c( 5, j ) - sum*t5
277 c( 6, j ) = c( 6, j ) - sum*t6
278 120 CONTINUE
279 GO TO 410
280 130 CONTINUE
281
282
283
284 v1 = conjg( v( 1 ) )
285 t1 = tau*conjg( v1 )
286 v2 = conjg( v( 2 ) )
287 t2 = tau*conjg( v2 )
288 v3 = conjg( v( 3 ) )
289 t3 = tau*conjg( v3 )
290 v4 = conjg( v( 4 ) )
291 t4 = tau*conjg( v4 )
292 v5 = conjg( v( 5 ) )
293 t5 = tau*conjg( v5 )
294 v6 = conjg( v( 6 ) )
295 t6 = tau*conjg( v6 )
296 v7 = conjg( v( 7 ) )
297 t7 = tau*conjg( v7 )
298 DO 140 j = 1, n
299 sum = v1*c( 1, j ) + v2*c( 2, j ) + v3*c( 3, j ) +
300 $ v4*c( 4, j ) + v5*c( 5, j ) + v6*c( 6, j ) +
301 $ v7*c( 7, j )
302 c( 1, j ) = c( 1, j ) - sum*t1
303 c( 2, j ) = c( 2, j ) - sum*t2
304 c( 3, j ) = c( 3, j ) - sum*t3
305 c( 4, j ) = c( 4, j ) - sum*t4
306 c( 5, j ) = c( 5, j ) - sum*t5
307 c( 6, j ) = c( 6, j ) - sum*t6
308 c( 7, j ) = c( 7, j ) - sum*t7
309 140 CONTINUE
310 GO TO 410
311 150 CONTINUE
312
313
314
315 v1 = conjg( v( 1 ) )
316 t1 = tau*conjg( v1 )
317 v2 = conjg( v( 2 ) )
318 t2 = tau*conjg( v2 )
319 v3 = conjg( v( 3 ) )
320 t3 = tau*conjg( v3 )
321 v4 = conjg( v( 4 ) )
322 t4 = tau*conjg( v4 )
323 v5 = conjg( v( 5 ) )
324 t5 = tau*conjg( v5 )
325 v6 = conjg( v( 6 ) )
326 t6 = tau*conjg( v6 )
327 v7 = conjg( v( 7 ) )
328 t7 = tau*conjg( v7 )
329 v8 = conjg( v( 8 ) )
330 t8 = tau*conjg( v8 )
331 DO 160 j = 1, n
332 sum = v1*c( 1, j ) + v2*c( 2, j ) + v3*c( 3, j ) +
333 $ v4*c( 4, j ) + v5*c( 5, j ) + v6*c( 6, j ) +
334 $ v7*c( 7, j ) + v8*c( 8, j )
335 c( 1, j ) = c( 1, j ) - sum*t1
336 c( 2, j ) = c( 2, j ) - sum*t2
337 c( 3, j ) = c( 3, j ) - sum*t3
338 c( 4, j ) = c( 4, j ) - sum*t4
339 c( 5, j ) = c( 5, j ) - sum*t5
340 c( 6, j ) = c( 6, j ) - sum*t6
341 c( 7, j ) = c( 7, j ) - sum*t7
342 c( 8, j ) = c( 8, j ) - sum*t8
343 160 CONTINUE
344 GO TO 410
345 170 CONTINUE
346
347
348
349 v1 = conjg( v( 1 ) )
350 t1 = tau*conjg( v1 )
351 v2 = conjg( v( 2 ) )
352 t2 = tau*conjg( v2 )
353 v3 = conjg( v( 3 ) )
354 t3 = tau*conjg( v3 )
355 v4 = conjg( v( 4 ) )
356 t4 = tau*conjg( v4 )
357 v5 = conjg( v( 5 ) )
358 t5 = tau*conjg( v5 )
359 v6 = conjg( v( 6 ) )
360 t6 = tau*conjg( v6 )
361 v7 = conjg( v( 7 ) )
362 t7 = tau*conjg( v7 )
363 v8 = conjg( v( 8 ) )
364 t8 = tau*conjg( v8 )
365 v9 = conjg( v( 9 ) )
366 t9 = tau*conjg( v9 )
367 DO 180 j = 1, n
368 sum = v1*c( 1, j ) + v2*c( 2, j ) + v3*c( 3, j ) +
369 $ v4*c( 4, j ) + v5*c( 5, j ) + v6*c( 6, j ) +
370 $ v7*c( 7, j ) + v8*c( 8, j ) + v9*c( 9, j )
371 c( 1, j ) = c( 1, j ) - sum*t1
372 c( 2, j ) = c( 2, j ) - sum*t2
373 c( 3, j ) = c( 3, j ) - sum*t3
374 c( 4, j ) = c( 4, j ) - sum*t4
375 c( 5, j ) = c( 5, j ) - sum*t5
376 c( 6, j ) = c( 6, j ) - sum*t6
377 c( 7, j ) = c( 7, j ) - sum*t7
378 c( 8, j ) = c( 8, j ) - sum*t8
379 c( 9, j ) = c( 9, j ) - sum*t9
380 180 CONTINUE
381 GO TO 410
382 190 CONTINUE
383
384
385
386 v1 = conjg( v( 1 ) )
387 t1 = tau*conjg( v1 )
388 v2 = conjg( v( 2 ) )
389 t2 = tau*conjg( v2 )
390 v3 = conjg( v( 3 ) )
391 t3 = tau*conjg( v3 )
392 v4 = conjg( v( 4 ) )
393 t4 = tau*conjg( v4 )
394 v5 = conjg( v( 5 ) )
395 t5 = tau*conjg( v5 )
396 v6 = conjg( v( 6 ) )
397 t6 = tau*conjg( v6 )
398 v7 = conjg( v( 7 ) )
399 t7 = tau*conjg( v7 )
400 v8 = conjg( v( 8 ) )
401 t8 = tau*conjg( v8 )
402 v9 = conjg( v( 9 ) )
403 t9 = tau*conjg( v9 )
404 v10 = conjg( v( 10 ) )
405 t10 = tau*conjg( v10 )
406 DO 200 j = 1, n
407 sum = v1*c( 1, j ) + v2*c( 2, j ) + v3*c( 3, j ) +
408 $ v4*c( 4, j ) + v5*c( 5, j ) + v6*c( 6, j ) +
409 $ v7*c( 7, j ) + v8*c( 8, j ) + v9*c( 9, j ) +
410 $ v10*c( 10, j )
411 c( 1, j ) = c( 1, j ) - sum*t1
412 c( 2, j ) = c( 2, j ) - sum*t2
413 c( 3, j ) = c( 3, j ) - sum*t3
414 c( 4, j ) = c( 4, j ) - sum*t4
415 c( 5, j ) = c( 5, j ) - sum*t5
416 c( 6, j ) = c( 6, j ) - sum*t6
417 c( 7, j ) = c( 7, j ) - sum*t7
418 c( 8, j ) = c( 8, j ) - sum*t8
419 c( 9, j ) = c( 9, j ) - sum*t9
420 c( 10, j ) = c( 10, j ) - sum*t10
421 200 CONTINUE
422 GO TO 410
423 ELSE
424
425
426
427 GO TO ( 210, 230, 250, 270, 290, 310, 330, 350,
428 $ 370, 390 )n
429
430
431
432 CALL clarf( side, m, n, v, 1, tau, c, ldc, work )
433 GO TO 410
434 210 CONTINUE
435
436
437
438 t1 = one - tau*v( 1 )*conjg( v( 1 ) )
439 DO 220 j = 1, m
440 c( j, 1 ) = t1*c( j, 1 )
441 220 CONTINUE
442 GO TO 410
443 230 CONTINUE
444
445
446
447 v1 = v( 1 )
448 t1 = tau*conjg( v1 )
449 v2 = v( 2 )
450 t2 = tau*conjg( v2 )
451 DO 240 j = 1, m
452 sum = v1*c( j, 1 ) + v2*c( j, 2 )
453 c( j, 1 ) = c( j, 1 ) - sum*t1
454 c( j, 2 ) = c( j, 2 ) - sum*t2
455 240 CONTINUE
456 GO TO 410
457 250 CONTINUE
458
459
460
461 v1 = v( 1 )
462 t1 = tau*conjg( v1 )
463 v2 = v( 2 )
464 t2 = tau*conjg( v2 )
465 v3 = v( 3 )
466 t3 = tau*conjg( v3 )
467 DO 260 j = 1, m
468 sum = v1*c( j, 1 ) + v2*c( j, 2 ) + v3*c( j, 3 )
469 c( j, 1 ) = c( j, 1 ) - sum*t1
470 c( j, 2 ) = c( j, 2 ) - sum*t2
471 c( j, 3 ) = c( j, 3 ) - sum*t3
472 260 CONTINUE
473 GO TO 410
474 270 CONTINUE
475
476
477
478 v1 = v( 1 )
479 t1 = tau*conjg( v1 )
480 v2 = v( 2 )
481 t2 = tau*conjg( v2 )
482 v3 = v( 3 )
483 t3 = tau*conjg( v3 )
484 v4 = v( 4 )
485 t4 = tau*conjg( v4 )
486 DO 280 j = 1, m
487 sum = v1*c( j, 1 ) + v2*c( j, 2 ) + v3*c( j, 3 ) +
488 $ v4*c( j, 4 )
489 c( j, 1 ) = c( j, 1 ) - sum*t1
490 c( j, 2 ) = c( j, 2 ) - sum*t2
491 c( j, 3 ) = c( j, 3 ) - sum*t3
492 c( j, 4 ) = c( j, 4 ) - sum*t4
493 280 CONTINUE
494 GO TO 410
495 290 CONTINUE
496
497
498
499 v1 = v( 1 )
500 t1 = tau*conjg( v1 )
501 v2 = v( 2 )
502 t2 = tau*conjg( v2 )
503 v3 = v( 3 )
504 t3 = tau*conjg( v3 )
505 v4 = v( 4 )
506 t4 = tau*conjg( v4 )
507 v5 = v( 5 )
508 t5 = tau*conjg( v5 )
509 DO 300 j = 1, m
510 sum = v1*c( j, 1 ) + v2*c( j, 2 ) + v3*c( j, 3 ) +
511 $ v4*c( j, 4 ) + v5*c( j, 5 )
512 c( j, 1 ) = c( j, 1 ) - sum*t1
513 c( j, 2 ) = c( j, 2 ) - sum*t2
514 c( j, 3 ) = c( j, 3 ) - sum*t3
515 c( j, 4 ) = c( j, 4 ) - sum*t4
516 c( j, 5 ) = c( j, 5 ) - sum*t5
517 300 CONTINUE
518 GO TO 410
519 310 CONTINUE
520
521
522
523 v1 = v( 1 )
524 t1 = tau*conjg( v1 )
525 v2 = v( 2 )
526 t2 = tau*conjg( v2 )
527 v3 = v( 3 )
528 t3 = tau*conjg( v3 )
529 v4 = v( 4 )
530 t4 = tau*conjg( v4 )
531 v5 = v( 5 )
532 t5 = tau*conjg( v5 )
533 v6 = v( 6 )
534 t6 = tau*conjg( v6 )
535 DO 320 j = 1, m
536 sum = v1*c( j, 1 ) + v2*c( j, 2 ) + v3*c( j, 3 ) +
537 $ v4*c( j, 4 ) + v5*c( j, 5 ) + v6*c( j, 6 )
538 c( j, 1 ) = c( j, 1 ) - sum*t1
539 c( j, 2 ) = c( j, 2 ) - sum*t2
540 c( j, 3 ) = c( j, 3 ) - sum*t3
541 c( j, 4 ) = c( j, 4 ) - sum*t4
542 c( j, 5 ) = c( j, 5 ) - sum*t5
543 c( j, 6 ) = c( j, 6 ) - sum*t6
544 320 CONTINUE
545 GO TO 410
546 330 CONTINUE
547
548
549
550 v1 = v( 1 )
551 t1 = tau*conjg( v1 )
552 v2 = v( 2 )
553 t2 = tau*conjg( v2 )
554 v3 = v( 3 )
555 t3 = tau*conjg( v3 )
556 v4 = v( 4 )
557 t4 = tau*conjg( v4 )
558 v5 = v( 5 )
559 t5 = tau*conjg( v5 )
560 v6 = v( 6 )
561 t6 = tau*conjg( v6 )
562 v7 = v( 7 )
563 t7 = tau*conjg( v7 )
564 DO 340 j = 1, m
565 sum = v1*c( j, 1 ) + v2*c( j, 2 ) + v3*c( j, 3 ) +
566 $ v4*c( j, 4 ) + v5*c( j, 5 ) + v6*c( j, 6 ) +
567 $ v7*c( j, 7 )
568 c( j, 1 ) = c( j, 1 ) - sum*t1
569 c( j, 2 ) = c( j, 2 ) - sum*t2
570 c( j, 3 ) = c( j, 3 ) - sum*t3
571 c( j, 4 ) = c( j, 4 ) - sum*t4
572 c( j, 5 ) = c( j, 5 ) - sum*t5
573 c( j, 6 ) = c( j, 6 ) - sum*t6
574 c( j, 7 ) = c( j, 7 ) - sum*t7
575 340 CONTINUE
576 GO TO 410
577 350 CONTINUE
578
579
580
581 v1 = v( 1 )
582 t1 = tau*conjg( v1 )
583 v2 = v( 2 )
584 t2 = tau*conjg( v2 )
585 v3 = v( 3 )
586 t3 = tau*conjg( v3 )
587 v4 = v( 4 )
588 t4 = tau*conjg( v4 )
589 v5 = v( 5 )
590 t5 = tau*conjg( v5 )
591 v6 = v( 6 )
592 t6 = tau*conjg( v6 )
593 v7 = v( 7 )
594 t7 = tau*conjg( v7 )
595 v8 = v( 8 )
596 t8 = tau*conjg( v8 )
597 DO 360 j = 1, m
598 sum = v1*c( j, 1 ) + v2*c( j, 2 ) + v3*c( j, 3 ) +
599 $ v4*c( j, 4 ) + v5*c( j, 5 ) + v6*c( j, 6 ) +
600 $ v7*c( j, 7 ) + v8*c( j, 8 )
601 c( j, 1 ) = c( j, 1 ) - sum*t1
602 c( j, 2 ) = c( j, 2 ) - sum*t2
603 c( j, 3 ) = c( j, 3 ) - sum*t3
604 c( j, 4 ) = c( j, 4 ) - sum*t4
605 c( j, 5 ) = c( j, 5 ) - sum*t5
606 c( j, 6 ) = c( j, 6 ) - sum*t6
607 c( j, 7 ) = c( j, 7 ) - sum*t7
608 c( j, 8 ) = c( j, 8 ) - sum*t8
609 360 CONTINUE
610 GO TO 410
611 370 CONTINUE
612
613
614
615 v1 = v( 1 )
616 t1 = tau*conjg( v1 )
617 v2 = v( 2 )
618 t2 = tau*conjg( v2 )
619 v3 = v( 3 )
620 t3 = tau*conjg( v3 )
621 v4 = v( 4 )
622 t4 = tau*conjg( v4 )
623 v5 = v( 5 )
624 t5 = tau*conjg( v5 )
625 v6 = v( 6 )
626 t6 = tau*conjg( v6 )
627 v7 = v( 7 )
628 t7 = tau*conjg( v7 )
629 v8 = v( 8 )
630 t8 = tau*conjg( v8 )
631 v9 = v( 9 )
632 t9 = tau*conjg( v9 )
633 DO 380 j = 1, m
634 sum = v1*c( j, 1 ) + v2*c( j, 2 ) + v3*c( j, 3 ) +
635 $ v4*c( j, 4 ) + v5*c( j, 5 ) + v6*c( j, 6 ) +
636 $ v7*c( j, 7 ) + v8*c( j, 8 ) + v9*c( j, 9 )
637 c( j, 1 ) = c( j, 1 ) - sum*t1
638 c( j, 2 ) = c( j, 2 ) - sum*t2
639 c( j, 3 ) = c( j, 3 ) - sum*t3
640 c( j, 4 ) = c( j, 4 ) - sum*t4
641 c( j, 5 ) = c( j, 5 ) - sum*t5
642 c( j, 6 ) = c( j, 6 ) - sum*t6
643 c( j, 7 ) = c( j, 7 ) - sum*t7
644 c( j, 8 ) = c( j, 8 ) - sum*t8
645 c( j, 9 ) = c( j, 9 ) - sum*t9
646 380 CONTINUE
647 GO TO 410
648 390 CONTINUE
649
650
651
652 v1 = v( 1 )
653 t1 = tau*conjg( v1 )
654 v2 = v( 2 )
655 t2 = tau*conjg( v2 )
656 v3 = v( 3 )
657 t3 = tau*conjg( v3 )
658 v4 = v( 4 )
659 t4 = tau*conjg( v4 )
660 v5 = v( 5 )
661 t5 = tau*conjg( v5 )
662 v6 = v( 6 )
663 t6 = tau*conjg( v6 )
664 v7 = v( 7 )
665 t7 = tau*conjg( v7 )
666 v8 = v( 8 )
667 t8 = tau*conjg( v8 )
668 v9 = v( 9 )
669 t9 = tau*conjg( v9 )
670 v10 = v( 10 )
671 t10 = tau*conjg( v10 )
672 DO 400 j = 1, m
673 sum = v1*c( j, 1 ) + v2*c( j, 2 ) + v3*c( j, 3 ) +
674 $ v4*c( j, 4 ) + v5*c( j, 5 ) + v6*c( j, 6 ) +
675 $ v7*c( j, 7 ) + v8*c( j, 8 ) + v9*c( j, 9 ) +
676 $ v10*c( j, 10 )
677 c( j, 1 ) = c( j, 1 ) - sum*t1
678 c( j, 2 ) = c( j, 2 ) - sum*t2
679 c( j, 3 ) = c( j, 3 ) - sum*t3
680 c( j, 4 ) = c( j, 4 ) - sum*t4
681 c( j, 5 ) = c( j, 5 ) - sum*t5
682 c( j, 6 ) = c( j, 6 ) - sum*t6
683 c( j, 7 ) = c( j, 7 ) - sum*t7
684 c( j, 8 ) = c( j, 8 ) - sum*t8
685 c( j, 9 ) = c( j, 9 ) - sum*t9
686 c( j, 10 ) = c( j, 10 ) - sum*t10
687 400 CONTINUE
688 GO TO 410
689 END IF
690 410 RETURN
691
692
693
subroutine clarf(side, m, n, v, incv, tau, c, ldc, work)
CLARF applies an elementary reflector to a general rectangular matrix.
logical function lsame(ca, cb)
LSAME