@@ -286,8 +286,8 @@ SUBROUTINE DLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS,
286286* ..
287287* .. Local Scalars ..
288288 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
291291 INTEGER I, I2, I4, INCOL, J, JBOT, JCOL, JLEN,
292292 $ JROW, JTOP, K, K1, KDU, KMS, KRCOL,
293293 $ M, M22, MBOT, MTOP, NBMPS, NDCOL,
@@ -447,11 +447,12 @@ SUBROUTINE DLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS,
447447* ==== Perform update from right within
448448* . computational window. ====
449449*
450+ T1 = V( 1 , M22 )
451+ T2 = T1* V( 2 , M22 )
450452 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
455456 30 CONTINUE
456457*
457458* ==== Perform update from left within
@@ -464,11 +465,12 @@ SUBROUTINE DLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS,
464465 ELSE
465466 JBOT = KBOT
466467 END IF
468+ T1 = V( 1 , M22 )
469+ T2 = T1* V( 2 , M22 )
467470 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
472474 40 CONTINUE
473475*
474476* ==== The following convergence test requires that
@@ -522,18 +524,20 @@ SUBROUTINE DLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS,
522524*
523525 IF ( ACCUM ) THEN
524526 KMS = K - INCOL
527+ T1 = V( 1 , M22 )
528+ T2 = T1* V( 2 , M22 )
525529 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
530533 50 CONTINUE
531534 ELSE IF ( WANTZ ) THEN
535+ T1 = V( 1 , M22 )
536+ T2 = T1* V( 2 , M22 )
532537 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
537541 60 CONTINUE
538542 END IF
539543 END IF
@@ -631,22 +635,25 @@ SUBROUTINE DLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS,
631635* . deflation check. We still delay most of the
632636* . updates from the left for efficiency. ====
633637*
638+ T1 = V( 1 , M )
639+ T2 = T1* V( 2 , M )
640+ T3 = T1* V( 3 , M )
634641 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
640647 70 CONTINUE
641648*
642649* ==== Perform update from left for subsequent
643650* . column. ====
644651*
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
650657*
651658* ==== The following convergence test requires that
652659* . the tradition small-compared-to-nearby-diagonals
@@ -706,12 +713,15 @@ SUBROUTINE DLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS,
706713*
707714 DO 100 M = MBOT, MTOP, - 1
708715 K = KRCOL + 2 * ( M-1 )
716+ T1 = V( 1 , M )
717+ T2 = T1* V( 2 , M )
718+ T3 = T1* V( 3 , M )
709719 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
715725 90 CONTINUE
716726 100 CONTINUE
717727*
@@ -729,12 +739,15 @@ SUBROUTINE DLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS,
729739 I2 = MAX ( 1 , KTOP- INCOL )
730740 I2 = MAX ( I2, KMS- (KRCOL- INCOL)+ 1 )
731741 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 )
732745 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
738751 110 CONTINUE
739752 120 CONTINUE
740753 ELSE IF ( WANTZ ) THEN
@@ -745,12 +758,15 @@ SUBROUTINE DLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS,
745758*
746759 DO 140 M = MBOT, MTOP, - 1
747760 K = KRCOL + 2 * ( M-1 )
761+ T1 = V( 1 , M )
762+ T2 = T1* V( 2 , M )
763+ T3 = T1* V( 3 , M )
748764 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
754770 130 CONTINUE
755771 140 CONTINUE
756772 END IF
0 commit comments