Skip to content

Commit 9f9295f

Browse files
angschangsch
committed
standardize style in laqr5
1 parent 22d1721 commit 9f9295f

File tree

4 files changed

+56
-40
lines changed

4 files changed

+56
-40
lines changed

‎SRC/claqr5.f‎

Lines changed: 14 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -533,11 +533,13 @@ SUBROUTINE CLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS, S,
533533
* . Mth bulge. Exploit fact that first two elements
534534
* . of row are actually zero. ====
535535
*
536-
REFSUM = V( 1, M )*V( 3, M )*H( K+3, K+2 )
537-
H( K+3, K ) = -REFSUM
538-
H( K+3, K+1 ) = -REFSUM*CONJG( V( 2, M ) )
539-
H( K+3, K+2 ) = H( K+3, K+2 ) -
540-
$ REFSUM*CONJG( V( 3, M ) )
536+
T1 = V( 1, M )
537+
T2 = T1*CONJG( V( 2, M ) )
538+
T3 = T1*CONJG( V( 3, M ) )
539+
REFSUM = V( 3, M )*H( K+3, K+2 )
540+
H( K+3, K ) = -REFSUM*T1
541+
H( K+3, K+1 ) = -REFSUM*T2
542+
H( K+3, K+2 ) = H( K+3, K+2 ) - REFSUM*T3
541543
*
542544
* ==== Calculate reflection to move
543545
* . Mth bulge one step. ====
@@ -572,12 +574,13 @@ SUBROUTINE CLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS, S,
572574
$ S( 2*M ), VT )
573575
ALPHA = VT( 1 )
574576
CALL CLARFG( 3, ALPHA, VT( 2 ), 1, VT( 1 ) )
575-
REFSUM = CONJG( VT( 1 ) )*
576-
$ ( H( K+1, K )+CONJG( VT( 2 ) )*
577-
$ H( K+2, K ) )
577+
T1 = CONJG( VT( 1 ) )
578+
T2 = T1*VT( 2 )
579+
T3 = T1*VT( 3 )
580+
REFSUM = H( K+1, K )+CONJG( VT( 2 ) )*H( K+2, K )
578581
*
579-
IF( CABS1( H( K+2, K )-REFSUM*VT( 2 ) )+
580-
$ CABS1( REFSUM*VT( 3 ) ).GT.ULP*
582+
IF( CABS1( H( K+2, K )-REFSUM*T2 )+
583+
$ CABS1( REFSUM*T3 ).GT.ULP*
581584
$ ( CABS1( H( K, K ) )+CABS1( H( K+1,
582585
$ K+1 ) )+CABS1( H( K+2, K+2 ) ) ) ) THEN
583586
*
@@ -595,7 +598,7 @@ SUBROUTINE CLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS, S,
595598
* . Replace the old reflector with
596599
* . the new one. ====
597600
*
598-
H( K+1, K ) = H( K+1, K ) - REFSUM
601+
H( K+1, K ) = H( K+1, K ) - REFSUM*T1
599602
H( K+2, K ) = ZERO
600603
H( K+3, K ) = ZERO
601604
V( 1, M ) = VT( 1 )

‎SRC/dlaqr5.f‎

Lines changed: 14 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -558,10 +558,13 @@ SUBROUTINE DLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS,
558558
* . Mth bulge. Exploit fact that first two elements
559559
* . of row are actually zero. ====
560560
*
561-
REFSUM = V( 1, M )*V( 3, M )*H( K+3, K+2 )
562-
H( K+3, K ) = -REFSUM
563-
H( K+3, K+1 ) = -REFSUM*V( 2, M )
564-
H( K+3, K+2 ) = H( K+3, K+2 ) - REFSUM*V( 3, M )
561+
T1 = V( 1, M )
562+
T2 = T1*V( 2, M )
563+
T3 = T1*V( 3, M )
564+
REFSUM = V( 3, M )*H( K+3, K+2 )
565+
H( K+3, K ) = -REFSUM*T1
566+
H( K+3, K+1 ) = -REFSUM*T2
567+
H( K+3, K+2 ) = H( K+3, K+2 ) - REFSUM*T3
565568
*
566569
* ==== Calculate reflection to move
567570
* . Mth bulge one step. ====
@@ -597,11 +600,13 @@ SUBROUTINE DLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS,
597600
$ VT )
598601
ALPHA = VT( 1 )
599602
CALL DLARFG( 3, ALPHA, VT( 2 ), 1, VT( 1 ) )
600-
REFSUM = VT( 1 )*( H( K+1, K )+VT( 2 )*
601-
$ H( K+2, K ) )
603+
T1 = VT( 1 )
604+
T2 = T1*VT( 2 )
605+
T3 = T1*VT( 3 )
606+
REFSUM = H( K+1, K ) + VT( 2 )*H( K+2, K )
602607
*
603-
IF( ABS( H( K+2, K )-REFSUM*VT( 2 ) )+
604-
$ ABS( REFSUM*VT( 3 ) ).GT.ULP*
608+
IF( ABS( H( K+2, K )-REFSUM*T2 )+
609+
$ ABS( REFSUM*T3 ).GT.ULP*
605610
$ ( ABS( H( K, K ) )+ABS( H( K+1,
606611
$ K+1 ) )+ABS( H( K+2, K+2 ) ) ) ) THEN
607612
*
@@ -619,7 +624,7 @@ SUBROUTINE DLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS,
619624
* . Replace the old reflector with
620625
* . the new one. ====
621626
*
622-
H( K+1, K ) = H( K+1, K ) - REFSUM
627+
H( K+1, K ) = H( K+1, K ) - REFSUM*T1
623628
H( K+2, K ) = ZERO
624629
H( K+3, K ) = ZERO
625630
V( 1, M ) = VT( 1 )

‎SRC/slaqr5.f‎

Lines changed: 14 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -558,10 +558,13 @@ SUBROUTINE SLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS,
558558
* . Mth bulge. Exploit fact that first two elements
559559
* . of row are actually zero. ====
560560
*
561-
REFSUM = V( 1, M )*V( 3, M )*H( K+3, K+2 )
562-
H( K+3, K ) = -REFSUM
563-
H( K+3, K+1 ) = -REFSUM*V( 2, M )
564-
H( K+3, K+2 ) = H( K+3, K+2 ) - REFSUM*V( 3, M )
561+
T1 = V( 1, M )
562+
T2 = T1*V( 2, M )
563+
T3 = T1*V( 3, M )
564+
REFSUM = V( 3, M )*H( K+3, K+2 )
565+
H( K+3, K ) = -REFSUM*T1
566+
H( K+3, K+1 ) = -REFSUM*T2
567+
H( K+3, K+2 ) = H( K+3, K+2 ) - REFSUM*T3
565568
*
566569
* ==== Calculate reflection to move
567570
* . Mth bulge one step. ====
@@ -597,11 +600,13 @@ SUBROUTINE SLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS,
597600
$ VT )
598601
ALPHA = VT( 1 )
599602
CALL SLARFG( 3, ALPHA, VT( 2 ), 1, VT( 1 ) )
600-
REFSUM = VT( 1 )*( H( K+1, K )+VT( 2 )*
601-
$ H( K+2, K ) )
603+
T1 = VT( 1 )
604+
T2 = T1*VT( 2 )
605+
T3 = T2*VT( 3 )
606+
REFSUM = H( K+1, K )+VT( 2 )*H( K+2, K )
602607
*
603-
IF( ABS( H( K+2, K )-REFSUM*VT( 2 ) )+
604-
$ ABS( REFSUM*VT( 3 ) ).GT.ULP*
608+
IF( ABS( H( K+2, K )-REFSUM*T2 )+
609+
$ ABS( REFSUM*T3 ).GT.ULP*
605610
$ ( ABS( H( K, K ) )+ABS( H( K+1,
606611
$ K+1 ) )+ABS( H( K+2, K+2 ) ) ) ) THEN
607612
*
@@ -619,7 +624,7 @@ SUBROUTINE SLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS,
619624
* . Replace the old reflector with
620625
* . the new one. ====
621626
*
622-
H( K+1, K ) = H( K+1, K ) - REFSUM
627+
H( K+1, K ) = H( K+1, K ) - REFSUM*T1
623628
H( K+2, K ) = ZERO
624629
H( K+3, K ) = ZERO
625630
V( 1, M ) = VT( 1 )

‎SRC/zlaqr5.f‎

Lines changed: 14 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -533,11 +533,13 @@ SUBROUTINE ZLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS, S,
533533
* . Mth bulge. Exploit fact that first two elements
534534
* . of row are actually zero. ====
535535
*
536-
REFSUM = V( 1, M )*V( 3, M )*H( K+3, K+2 )
537-
H( K+3, K ) = -REFSUM
538-
H( K+3, K+1 ) = -REFSUM*DCONJG( V( 2, M ) )
539-
H( K+3, K+2 ) = H( K+3, K+2 ) -
540-
$ REFSUM*DCONJG( V( 3, M ) )
536+
T1 = V( 1, M )
537+
T2 = T1*DCONJG( V( 2, M ) )
538+
T3 = T1*DCONJG( V( 3, M ) )
539+
REFSUM = V( 3, M )*H( K+3, K+2 )
540+
H( K+3, K ) = -REFSUM*T1
541+
H( K+3, K+1 ) = -REFSUM*T2
542+
H( K+3, K+2 ) = H( K+3, K+2 ) - REFSUM*T3
541543
*
542544
* ==== Calculate reflection to move
543545
* . Mth bulge one step. ====
@@ -572,12 +574,13 @@ SUBROUTINE ZLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS, S,
572574
$ S( 2*M ), VT )
573575
ALPHA = VT( 1 )
574576
CALL ZLARFG( 3, ALPHA, VT( 2 ), 1, VT( 1 ) )
575-
REFSUM = DCONJG( VT( 1 ) )*
576-
$ ( H( K+1, K )+DCONJG( VT( 2 ) )*
577-
$ H( K+2, K ) )
577+
T1 = DCONJG( VT( 1 ) )
578+
T2 = T1*VT( 2 )
579+
T3 = T1*VT( 3 )
580+
REFSUM = H( K+1, K )+DCONJG( VT( 2 ) )*H( K+2, K )
578581
*
579-
IF( CABS1( H( K+2, K )-REFSUM*VT( 2 ) )+
580-
$ CABS1( REFSUM*VT( 3 ) ).GT.ULP*
582+
IF( CABS1( H( K+2, K )-REFSUM*T2 )+
583+
$ CABS1( REFSUM*T3 ).GT.ULP*
581584
$ ( CABS1( H( K, K ) )+CABS1( H( K+1,
582585
$ K+1 ) )+CABS1( H( K+2, K+2 ) ) ) ) THEN
583586
*
@@ -595,7 +598,7 @@ SUBROUTINE ZLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS, S,
595598
* . Replace the old reflector with
596599
* . the new one. ====
597600
*
598-
H( K+1, K ) = H( K+1, K ) - REFSUM
601+
H( K+1, K ) = H( K+1, K ) - REFSUM*T1
599602
H( K+2, K ) = ZERO
600603
H( K+3, K ) = ZERO
601604
V( 1, M ) = VT( 1 )

0 commit comments

Comments
 (0)