119
120
121
122
123
124
125 CHARACTER SIDE
126 INTEGER LDC, M, N
127 COMPLEX TAU
128
129
130 COMPLEX C( LDC, * ), V( * ), WORK( * )
131
132
133
134
135
136 COMPLEX ZERO, ONE
137 parameter( zero = ( 0.0e+0, 0.0e+0 ),
138 $ one = ( 1.0e+0, 0.0e+0 ) )
139
140
141 INTEGER J
142 COMPLEX 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 INTRINSIC conjg
154
155
156
157 IF( tau.EQ.zero )
158 $ RETURN
159 IF(
lsame( side,
'L' ) )
THEN
160
161
162
163 GO TO ( 10, 30, 50, 70, 90, 110, 130, 150,
164 $ 170, 190 )m
165
166
167
168 CALL clarf( side, m, n, v, 1, tau, c, ldc, work )
169 GO TO 410
170 10 CONTINUE
171
172
173
174 t1 = one - tau*v( 1 )*conjg( v( 1 ) )
175 DO 20 j = 1, n
176 c( 1, j ) = t1*c( 1, j )
177 20 CONTINUE
178 GO TO 410
179 30 CONTINUE
180
181
182
183 v1 = conjg( v( 1 ) )
184 t1 = tau*conjg( v1 )
185 v2 = conjg( v( 2 ) )
186 t2 = tau*conjg( v2 )
187 DO 40 j = 1, n
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
191 40 CONTINUE
192 GO TO 410
193 50 CONTINUE
194
195
196
197 v1 = conjg( v( 1 ) )
198 t1 = tau*conjg( v1 )
199 v2 = conjg( v( 2 ) )
200 t2 = tau*conjg( v2 )
201 v3 = conjg( v( 3 ) )
202 t3 = tau*conjg( v3 )
203 DO 60 j = 1, n
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
208 60 CONTINUE
209 GO TO 410
210 70 CONTINUE
211
212
213
214 v1 = conjg( v( 1 ) )
215 t1 = tau*conjg( v1 )
216 v2 = conjg( v( 2 ) )
217 t2 = tau*conjg( v2 )
218 v3 = conjg( v( 3 ) )
219 t3 = tau*conjg( v3 )
220 v4 = conjg( v( 4 ) )
221 t4 = tau*conjg( v4 )
222 DO 80 j = 1, n
223 sum = v1*c( 1, j ) + v2*c( 2, j ) + v3*c( 3, j ) +
224 $ v4*c( 4, 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
229 80 CONTINUE
230 GO TO 410
231 90 CONTINUE
232
233
234
235 v1 = conjg( v( 1 ) )
236 t1 = tau*conjg( v1 )
237 v2 = conjg( v( 2 ) )
238 t2 = tau*conjg( v2 )
239 v3 = conjg( v( 3 ) )
240 t3 = tau*conjg( v3 )
241 v4 = conjg( v( 4 ) )
242 t4 = tau*conjg( v4 )
243 v5 = conjg( v( 5 ) )
244 t5 = tau*conjg( v5 )
245 DO 100 j = 1, n
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
253 100 CONTINUE
254 GO TO 410
255 110 CONTINUE
256
257
258
259 v1 = conjg( v( 1 ) )
260 t1 = tau*conjg( v1 )
261 v2 = conjg( v( 2 ) )
262 t2 = tau*conjg( v2 )
263 v3 = conjg( v( 3 ) )
264 t3 = tau*conjg( v3 )
265 v4 = conjg( v( 4 ) )
266 t4 = tau*conjg( v4 )
267 v5 = conjg( v( 5 ) )
268 t5 = tau*conjg( v5 )
269 v6 = conjg( v( 6 ) )
270 t6 = tau*conjg( v6 )
271 DO 120 j = 1, n
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
280 120 CONTINUE
281 GO TO 410
282 130 CONTINUE
283
284
285
286 v1 = conjg( v( 1 ) )
287 t1 = tau*conjg( v1 )
288 v2 = conjg( v( 2 ) )
289 t2 = tau*conjg( v2 )
290 v3 = conjg( v( 3 ) )
291 t3 = tau*conjg( v3 )
292 v4 = conjg( v( 4 ) )
293 t4 = tau*conjg( v4 )
294 v5 = conjg( v( 5 ) )
295 t5 = tau*conjg( v5 )
296 v6 = conjg( v( 6 ) )
297 t6 = tau*conjg( v6 )
298 v7 = conjg( v( 7 ) )
299 t7 = tau*conjg( v7 )
300 DO 140 j = 1, n
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 ) +
303 $ v7*c( 7, 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
311 140 CONTINUE
312 GO TO 410
313 150 CONTINUE
314
315
316
317 v1 = conjg( v( 1 ) )
318 t1 = tau*conjg( v1 )
319 v2 = conjg( v( 2 ) )
320 t2 = tau*conjg( v2 )
321 v3 = conjg( v( 3 ) )
322 t3 = tau*conjg( v3 )
323 v4 = conjg( v( 4 ) )
324 t4 = tau*conjg( v4 )
325 v5 = conjg( v( 5 ) )
326 t5 = tau*conjg( v5 )
327 v6 = conjg( v( 6 ) )
328 t6 = tau*conjg( v6 )
329 v7 = conjg( v( 7 ) )
330 t7 = tau*conjg( v7 )
331 v8 = conjg( v( 8 ) )
332 t8 = tau*conjg( v8 )
333 DO 160 j = 1, n
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
345 160 CONTINUE
346 GO TO 410
347 170 CONTINUE
348
349
350
351 v1 = conjg( v( 1 ) )
352 t1 = tau*conjg( v1 )
353 v2 = conjg( v( 2 ) )
354 t2 = tau*conjg( v2 )
355 v3 = conjg( v( 3 ) )
356 t3 = tau*conjg( v3 )
357 v4 = conjg( v( 4 ) )
358 t4 = tau*conjg( v4 )
359 v5 = conjg( v( 5 ) )
360 t5 = tau*conjg( v5 )
361 v6 = conjg( v( 6 ) )
362 t6 = tau*conjg( v6 )
363 v7 = conjg( v( 7 ) )
364 t7 = tau*conjg( v7 )
365 v8 = conjg( v( 8 ) )
366 t8 = tau*conjg( v8 )
367 v9 = conjg( v( 9 ) )
368 t9 = tau*conjg( v9 )
369 DO 180 j = 1, n
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
382 180 CONTINUE
383 GO TO 410
384 190 CONTINUE
385
386
387
388 v1 = conjg( v( 1 ) )
389 t1 = tau*conjg( v1 )
390 v2 = conjg( v( 2 ) )
391 t2 = tau*conjg( v2 )
392 v3 = conjg( v( 3 ) )
393 t3 = tau*conjg( v3 )
394 v4 = conjg( v( 4 ) )
395 t4 = tau*conjg( v4 )
396 v5 = conjg( v( 5 ) )
397 t5 = tau*conjg( v5 )
398 v6 = conjg( v( 6 ) )
399 t6 = tau*conjg( v6 )
400 v7 = conjg( v( 7 ) )
401 t7 = tau*conjg( v7 )
402 v8 = conjg( v( 8 ) )
403 t8 = tau*conjg( v8 )
404 v9 = conjg( v( 9 ) )
405 t9 = tau*conjg( v9 )
406 v10 = conjg( v( 10 ) )
407 t10 = tau*conjg( v10 )
408 DO 200 j = 1, n
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 ) +
412 $ v10*c( 10, 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
423 200 CONTINUE
424 GO TO 410
425 ELSE
426
427
428
429 GO TO ( 210, 230, 250, 270, 290, 310, 330, 350,
430 $ 370, 390 )n
431
432
433
434 CALL clarf( side, m, n, v, 1, tau, c, ldc, work )
435 GO TO 410
436 210 CONTINUE
437
438
439
440 t1 = one - tau*v( 1 )*conjg( v( 1 ) )
441 DO 220 j = 1, m
442 c( j, 1 ) = t1*c( j, 1 )
443 220 CONTINUE
444 GO TO 410
445 230 CONTINUE
446
447
448
449 v1 = v( 1 )
450 t1 = tau*conjg( v1 )
451 v2 = v( 2 )
452 t2 = tau*conjg( v2 )
453 DO 240 j = 1, m
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
457 240 CONTINUE
458 GO TO 410
459 250 CONTINUE
460
461
462
463 v1 = v( 1 )
464 t1 = tau*conjg( v1 )
465 v2 = v( 2 )
466 t2 = tau*conjg( v2 )
467 v3 = v( 3 )
468 t3 = tau*conjg( v3 )
469 DO 260 j = 1, m
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
474 260 CONTINUE
475 GO TO 410
476 270 CONTINUE
477
478
479
480 v1 = v( 1 )
481 t1 = tau*conjg( v1 )
482 v2 = v( 2 )
483 t2 = tau*conjg( v2 )
484 v3 = v( 3 )
485 t3 = tau*conjg( v3 )
486 v4 = v( 4 )
487 t4 = tau*conjg( v4 )
488 DO 280 j = 1, m
489 sum = v1*c( j, 1 ) + v2*c( j, 2 ) + v3*c( j, 3 ) +
490 $ v4*c( j, 4 )
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
495 280 CONTINUE
496 GO TO 410
497 290 CONTINUE
498
499
500
501 v1 = v( 1 )
502 t1 = tau*conjg( v1 )
503 v2 = v( 2 )
504 t2 = tau*conjg( v2 )
505 v3 = v( 3 )
506 t3 = tau*conjg( v3 )
507 v4 = v( 4 )
508 t4 = tau*conjg( v4 )
509 v5 = v( 5 )
510 t5 = tau*conjg( v5 )
511 DO 300 j = 1, m
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
519 300 CONTINUE
520 GO TO 410
521 310 CONTINUE
522
523
524
525 v1 = v( 1 )
526 t1 = tau*conjg( v1 )
527 v2 = v( 2 )
528 t2 = tau*conjg( v2 )
529 v3 = v( 3 )
530 t3 = tau*conjg( v3 )
531 v4 = v( 4 )
532 t4 = tau*conjg( v4 )
533 v5 = v( 5 )
534 t5 = tau*conjg( v5 )
535 v6 = v( 6 )
536 t6 = tau*conjg( v6 )
537 DO 320 j = 1, m
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
546 320 CONTINUE
547 GO TO 410
548 330 CONTINUE
549
550
551
552 v1 = v( 1 )
553 t1 = tau*conjg( v1 )
554 v2 = v( 2 )
555 t2 = tau*conjg( v2 )
556 v3 = v( 3 )
557 t3 = tau*conjg( v3 )
558 v4 = v( 4 )
559 t4 = tau*conjg( v4 )
560 v5 = v( 5 )
561 t5 = tau*conjg( v5 )
562 v6 = v( 6 )
563 t6 = tau*conjg( v6 )
564 v7 = v( 7 )
565 t7 = tau*conjg( v7 )
566 DO 340 j = 1, m
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 ) +
569 $ v7*c( j, 7 )
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
577 340 CONTINUE
578 GO TO 410
579 350 CONTINUE
580
581
582
583 v1 = v( 1 )
584 t1 = tau*conjg( v1 )
585 v2 = v( 2 )
586 t2 = tau*conjg( v2 )
587 v3 = v( 3 )
588 t3 = tau*conjg( v3 )
589 v4 = v( 4 )
590 t4 = tau*conjg( v4 )
591 v5 = v( 5 )
592 t5 = tau*conjg( v5 )
593 v6 = v( 6 )
594 t6 = tau*conjg( v6 )
595 v7 = v( 7 )
596 t7 = tau*conjg( v7 )
597 v8 = v( 8 )
598 t8 = tau*conjg( v8 )
599 DO 360 j = 1, m
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
611 360 CONTINUE
612 GO TO 410
613 370 CONTINUE
614
615
616
617 v1 = v( 1 )
618 t1 = tau*conjg( v1 )
619 v2 = v( 2 )
620 t2 = tau*conjg( v2 )
621 v3 = v( 3 )
622 t3 = tau*conjg( v3 )
623 v4 = v( 4 )
624 t4 = tau*conjg( v4 )
625 v5 = v( 5 )
626 t5 = tau*conjg( v5 )
627 v6 = v( 6 )
628 t6 = tau*conjg( v6 )
629 v7 = v( 7 )
630 t7 = tau*conjg( v7 )
631 v8 = v( 8 )
632 t8 = tau*conjg( v8 )
633 v9 = v( 9 )
634 t9 = tau*conjg( v9 )
635 DO 380 j = 1, m
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
648 380 CONTINUE
649 GO TO 410
650 390 CONTINUE
651
652
653
654 v1 = v( 1 )
655 t1 = tau*conjg( v1 )
656 v2 = v( 2 )
657 t2 = tau*conjg( v2 )
658 v3 = v( 3 )
659 t3 = tau*conjg( v3 )
660 v4 = v( 4 )
661 t4 = tau*conjg( v4 )
662 v5 = v( 5 )
663 t5 = tau*conjg( v5 )
664 v6 = v( 6 )
665 t6 = tau*conjg( v6 )
666 v7 = v( 7 )
667 t7 = tau*conjg( v7 )
668 v8 = v( 8 )
669 t8 = tau*conjg( v8 )
670 v9 = v( 9 )
671 t9 = tau*conjg( v9 )
672 v10 = v( 10 )
673 t10 = tau*conjg( v10 )
674 DO 400 j = 1, m
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 ) +
678 $ v10*c( j, 10 )
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
689 400 CONTINUE
690 GO TO 410
691 END IF
692 410 RETURN
693
694
695
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