@@ -286,8 +286,8 @@ SUBROUTINE DLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS,
286
286
* ..
287
287
* .. Local Scalars ..
288
288
DOUBLE PRECISION ALPHA, BETA, H11, H12, H21, H22, REFSUM,
289
- $ SAFMAX, SAFMIN, SCL, SMLNUM, SWAP, TST1, TST2 ,
290
- $ ULP
289
+ $ SAFMAX, SAFMIN, SCL, SMLNUM, SWAP, T1, T2 ,
290
+ $ T3, TST1, TST2, ULP
291
291
INTEGER I, I2, I4, INCOL, J, JBOT, JCOL, JLEN,
292
292
$ JROW, JTOP, K, K1, KDU, KMS, KRCOL,
293
293
$ M, M22, MBOT, MTOP, NBMPS, NDCOL,
@@ -447,11 +447,12 @@ SUBROUTINE DLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS,
447
447
* ==== Perform update from right within
448
448
* . computational window. ====
449
449
*
450
+ T1 = V( 1 , M22 )
451
+ T2 = T1* V( 2 , M22 )
450
452
DO 30 J = JTOP, MIN ( KBOT, K+3 )
451
- REFSUM = V( 1 , M22 )* ( H( J, K+1 )+ V( 2 , M22 )*
452
- $ H( J, K+2 ) )
453
- H( J, K+1 ) = H( J, K+1 ) - REFSUM
454
- H( J, K+2 ) = H( J, K+2 ) - REFSUM* V( 2 , M22 )
453
+ REFSUM = H( J, K+1 ) + V( 2 , M22 )* H( J, K+2 )
454
+ H( J, K+1 ) = H( J, K+1 ) - REFSUM* T1
455
+ H( J, K+2 ) = H( J, K+2 ) - REFSUM* T2
455
456
30 CONTINUE
456
457
*
457
458
* ==== Perform update from left within
@@ -464,11 +465,12 @@ SUBROUTINE DLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS,
464
465
ELSE
465
466
JBOT = KBOT
466
467
END IF
468
+ T1 = V( 1 , M22 )
469
+ T2 = T1* V( 2 , M22 )
467
470
DO 40 J = K+1 , JBOT
468
- REFSUM = V( 1 , M22 )* ( H( K+1 , J )+ V( 2 , M22 )*
469
- $ H( K+2 , J ) )
470
- H( K+1 , J ) = H( K+1 , J ) - REFSUM
471
- H( K+2 , J ) = H( K+2 , J ) - REFSUM* V( 2 , M22 )
471
+ REFSUM = H( K+1 , J ) + V( 2 , M22 )* H( K+2 , J )
472
+ H( K+1 , J ) = H( K+1 , J ) - REFSUM* T1
473
+ H( K+2 , J ) = H( K+2 , J ) - REFSUM* T2
472
474
40 CONTINUE
473
475
*
474
476
* ==== The following convergence test requires that
@@ -522,18 +524,20 @@ SUBROUTINE DLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS,
522
524
*
523
525
IF ( ACCUM ) THEN
524
526
KMS = K - INCOL
527
+ T1 = V( 1 , M22 )
528
+ T2 = T1* V( 2 , M22 )
525
529
DO 50 J = MAX ( 1 , KTOP- INCOL ), KDU
526
- REFSUM = V( 1 , M22 )* ( U( J, KMS+1 )+
527
- $ V( 2 , M22 )* U( J, KMS+2 ) )
528
- U( J, KMS+1 ) = U( J, KMS+1 ) - REFSUM
529
- U( J, KMS+2 ) = U( J, KMS+2 ) - REFSUM* V( 2 , M22 )
530
+ REFSUM = U( J, KMS+1 ) + V( 2 , M22 )* U( J, KMS+2 )
531
+ U( J, KMS+1 ) = U( J, KMS+1 ) - REFSUM* T1
532
+ U( J, KMS+2 ) = U( J, KMS+2 ) - REFSUM* T2
530
533
50 CONTINUE
531
534
ELSE IF ( WANTZ ) THEN
535
+ T1 = V( 1 , M22 )
536
+ T2 = T1* V( 2 , M22 )
532
537
DO 60 J = ILOZ, IHIZ
533
- REFSUM = V( 1 , M22 )* ( Z( J, K+1 )+ V( 2 , M22 )*
534
- $ Z( J, K+2 ) )
535
- Z( J, K+1 ) = Z( J, K+1 ) - REFSUM
536
- Z( J, K+2 ) = Z( J, K+2 ) - REFSUM* V( 2 , M22 )
538
+ REFSUM = Z( J, K+1 )+ V( 2 , M22 )* Z( J, K+2 )
539
+ Z( J, K+1 ) = Z( J, K+1 ) - REFSUM* T1
540
+ Z( J, K+2 ) = Z( J, K+2 ) - REFSUM* T2
537
541
60 CONTINUE
538
542
END IF
539
543
END IF
@@ -631,22 +635,25 @@ SUBROUTINE DLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS,
631
635
* . deflation check. We still delay most of the
632
636
* . updates from the left for efficiency. ====
633
637
*
638
+ T1 = V( 1 , M )
639
+ T2 = T1* V( 2 , M )
640
+ T3 = T1* V( 3 , M )
634
641
DO 70 J = JTOP, MIN ( KBOT, K+3 )
635
- REFSUM = V( 1 , M ) * ( H( J, K+1 )+ V( 2 , M )*
636
- $ H( J, K +2 ) + V( 3 , M )* H( J, K+3 ) )
637
- H( J, K+1 ) = H( J, K+1 ) - REFSUM
638
- H( J, K+2 ) = H( J, K+2 ) - REFSUM* V( 2 , M )
639
- H( J, K+3 ) = H( J, K+3 ) - REFSUM* V( 3 , M )
642
+ REFSUM = H( J, K+1 ) + V( 2 , M )* H( J, K +2 )
643
+ $ + V( 3 , M )* H( J, K+3 )
644
+ H( J, K+1 ) = H( J, K+1 ) - REFSUM* T1
645
+ H( J, K+2 ) = H( J, K+2 ) - REFSUM* T2
646
+ H( J, K+3 ) = H( J, K+3 ) - REFSUM* T3
640
647
70 CONTINUE
641
648
*
642
649
* ==== Perform update from left for subsequent
643
650
* . column. ====
644
651
*
645
- REFSUM = V( 1 , M ) * ( H( K+1 , K+1 )+ V( 2 , M )*
646
- $ H( K +2 , K +1 ) + V( 3 , M )* H( K+3 , K+1 ) )
647
- H( K+1 , K+1 ) = H( K+1 , K+1 ) - REFSUM
648
- H( K+2 , K+1 ) = H( K+2 , K+1 ) - REFSUM* V( 2 , M )
649
- H( K+3 , K+1 ) = H( K+3 , K+1 ) - REFSUM* V( 3 , M )
652
+ REFSUM = H( K+1 , K+1 ) + V( 2 , M )* H( K +2 , K +1 )
653
+ $ + V( 3 , M )* H( K+3 , K+1 )
654
+ H( K+1 , K+1 ) = H( K+1 , K+1 ) - REFSUM* T1
655
+ H( K+2 , K+1 ) = H( K+2 , K+1 ) - REFSUM* T2
656
+ H( K+3 , K+1 ) = H( K+3 , K+1 ) - REFSUM* T3
650
657
*
651
658
* ==== The following convergence test requires that
652
659
* . the tradition small-compared-to-nearby-diagonals
@@ -706,12 +713,15 @@ SUBROUTINE DLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS,
706
713
*
707
714
DO 100 M = MBOT, MTOP, - 1
708
715
K = KRCOL + 2 * ( M-1 )
716
+ T1 = V( 1 , M )
717
+ T2 = T1* V( 2 , M )
718
+ T3 = T1* V( 3 , M )
709
719
DO 90 J = MAX ( KTOP, KRCOL + 2 * M ), JBOT
710
- REFSUM = V( 1 , M ) * ( H( K+1 , J )+ V( 2 , M )*
711
- $ H( K +2 , J ) + V( 3 , M )* H( K+3 , J ) )
712
- H( K+1 , J ) = H( K+1 , J ) - REFSUM
713
- H( K+2 , J ) = H( K+2 , J ) - REFSUM* V( 2 , M )
714
- H( K+3 , J ) = H( K+3 , J ) - REFSUM* V( 3 , M )
720
+ REFSUM = H( K+1 , J ) + V( 2 , M )* H( K +2 , J )
721
+ $ + V( 3 , M )* H( K+3 , J )
722
+ H( K+1 , J ) = H( K+1 , J ) - REFSUM* T1
723
+ H( K+2 , J ) = H( K+2 , J ) - REFSUM* T2
724
+ H( K+3 , J ) = H( K+3 , J ) - REFSUM* T3
715
725
90 CONTINUE
716
726
100 CONTINUE
717
727
*
@@ -729,12 +739,15 @@ SUBROUTINE DLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS,
729
739
I2 = MAX ( 1 , KTOP- INCOL )
730
740
I2 = MAX ( I2, KMS- (KRCOL- INCOL)+ 1 )
731
741
I4 = MIN ( KDU, KRCOL + 2 * ( MBOT-1 ) - INCOL + 5 )
742
+ T1 = V( 1 , M )
743
+ T2 = T1* V( 2 , M )
744
+ T3 = T1* V( 3 , M )
732
745
DO 110 J = I2, I4
733
- REFSUM = V( 1 , M ) * ( U( J, KMS+1 )+ V( 2 , M )*
734
- $ U( J, KMS +2 ) + V( 3 , M )* U( J, KMS+3 ) )
735
- U( J, KMS+1 ) = U( J, KMS+1 ) - REFSUM
736
- U( J, KMS+2 ) = U( J, KMS+2 ) - REFSUM* V( 2 , M )
737
- U( J, KMS+3 ) = U( J, KMS+3 ) - REFSUM* V( 3 , M )
746
+ REFSUM = U( J, KMS+1 ) + V( 2 , M )* U( J, KMS +2 )
747
+ $ + V( 3 , M )* U( J, KMS+3 )
748
+ U( J, KMS+1 ) = U( J, KMS+1 ) - REFSUM* T1
749
+ U( J, KMS+2 ) = U( J, KMS+2 ) - REFSUM* T2
750
+ U( J, KMS+3 ) = U( J, KMS+3 ) - REFSUM* T3
738
751
110 CONTINUE
739
752
120 CONTINUE
740
753
ELSE IF ( WANTZ ) THEN
@@ -745,12 +758,15 @@ SUBROUTINE DLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS,
745
758
*
746
759
DO 140 M = MBOT, MTOP, - 1
747
760
K = KRCOL + 2 * ( M-1 )
761
+ T1 = V( 1 , M )
762
+ T2 = T1* V( 2 , M )
763
+ T3 = T1* V( 3 , M )
748
764
DO 130 J = ILOZ, IHIZ
749
- REFSUM = V( 1 , M ) * ( Z( J, K+1 )+ V( 2 , M )*
750
- $ Z( J, K +2 ) + V( 3 , M )* Z( J, K+3 ) )
751
- Z( J, K+1 ) = Z( J, K+1 ) - REFSUM
752
- Z( J, K+2 ) = Z( J, K+2 ) - REFSUM* V( 2 , M )
753
- Z( J, K+3 ) = Z( J, K+3 ) - REFSUM* V( 3 , M )
765
+ REFSUM = Z( J, K+1 ) + V( 2 , M )* Z( J, K +2 )
766
+ $ + V( 3 , M )* Z( J, K+3 )
767
+ Z( J, K+1 ) = Z( J, K+1 ) - REFSUM* T1
768
+ Z( J, K+2 ) = Z( J, K+2 ) - REFSUM* T2
769
+ Z( J, K+3 ) = Z( J, K+3 ) - REFSUM* T3
754
770
130 CONTINUE
755
771
140 CONTINUE
756
772
END IF
0 commit comments