Skip to content

Add numerical tests for trevc3 #682

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 3 commits into from
Mar 18, 2023
Merged

Add numerical tests for trevc3 #682

Show file tree
Hide file tree
Changes from 1 commit
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
22d1721
Add missing numerical tests for TREVC3
angsch Jun 19, 2022
9f9295f
standardize style in laqr5
angsch Jul 3, 2022
0a6cd43
Rewrite [ds]hgeqz to use FMA with Householder reflectors
angsch Jul 5, 2022
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
Prev Previous commit
Next Next commit
standardize style in laqr5
  • Loading branch information
@angsch
angsch committed Jul 6, 2022
commit 9f9295f5729931a00dc5c3b93da3c8541584ab82
25 changes: 14 additions & 11 deletions SRC/claqr5.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -533,11 +533,13 @@ SUBROUTINE CLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS, S,
* . Mth bulge. Exploit fact that first two elements
* . of row are actually zero. ====
*
REFSUM = V( 1, M )*V( 3, M )*H( K+3, K+2 )
H( K+3, K ) = -REFSUM
H( K+3, K+1 ) = -REFSUM*CONJG( V( 2, M ) )
H( K+3, K+2 ) = H( K+3, K+2 ) -
$ REFSUM*CONJG( V( 3, M ) )
T1 = V( 1, M )
T2 = T1*CONJG( V( 2, M ) )
T3 = T1*CONJG( V( 3, M ) )
REFSUM = V( 3, M )*H( K+3, K+2 )
H( K+3, K ) = -REFSUM*T1
H( K+3, K+1 ) = -REFSUM*T2
H( K+3, K+2 ) = H( K+3, K+2 ) - REFSUM*T3
*
* ==== Calculate reflection to move
* . Mth bulge one step. ====
Expand Down Expand Up @@ -572,12 +574,13 @@ SUBROUTINE CLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS, S,
$ S( 2*M ), VT )
ALPHA = VT( 1 )
CALL CLARFG( 3, ALPHA, VT( 2 ), 1, VT( 1 ) )
REFSUM = CONJG( VT( 1 ) )*
$ ( H( K+1, K )+CONJG( VT( 2 ) )*
$ H( K+2, K ) )
T1 = CONJG( VT( 1 ) )
T2 = T1*VT( 2 )
T3 = T1*VT( 3 )
REFSUM = H( K+1, K )+CONJG( VT( 2 ) )*H( K+2, K )
*
IF( CABS1( H( K+2, K )-REFSUM*VT( 2 ) )+
$ CABS1( REFSUM*VT( 3 ) ).GT.ULP*
IF( CABS1( H( K+2, K )-REFSUM*T2 )+
$ CABS1( REFSUM*T3 ).GT.ULP*
$ ( CABS1( H( K, K ) )+CABS1( H( K+1,
$ K+1 ) )+CABS1( H( K+2, K+2 ) ) ) ) THEN
*
Expand All @@ -595,7 +598,7 @@ SUBROUTINE CLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS, S,
* . Replace the old reflector with
* . the new one. ====
*
H( K+1, K ) = H( K+1, K ) - REFSUM
H( K+1, K ) = H( K+1, K ) - REFSUM*T1
H( K+2, K ) = ZERO
H( K+3, K ) = ZERO
V( 1, M ) = VT( 1 )
Expand Down
23 changes: 14 additions & 9 deletions SRC/dlaqr5.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -558,10 +558,13 @@ SUBROUTINE DLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS,
* . Mth bulge. Exploit fact that first two elements
* . of row are actually zero. ====
*
REFSUM = V( 1, M )*V( 3, M )*H( K+3, K+2 )
H( K+3, K ) = -REFSUM
H( K+3, K+1 ) = -REFSUM*V( 2, M )
H( K+3, K+2 ) = H( K+3, K+2 ) - REFSUM*V( 3, M )
T1 = V( 1, M )
T2 = T1*V( 2, M )
T3 = T1*V( 3, M )
REFSUM = V( 3, M )*H( K+3, K+2 )
H( K+3, K ) = -REFSUM*T1
H( K+3, K+1 ) = -REFSUM*T2
H( K+3, K+2 ) = H( K+3, K+2 ) - REFSUM*T3
*
* ==== Calculate reflection to move
* . Mth bulge one step. ====
Expand Down Expand Up @@ -597,11 +600,13 @@ SUBROUTINE DLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS,
$ VT )
ALPHA = VT( 1 )
CALL DLARFG( 3, ALPHA, VT( 2 ), 1, VT( 1 ) )
REFSUM = VT( 1 )*( H( K+1, K )+VT( 2 )*
$ H( K+2, K ) )
T1 = VT( 1 )
T2 = T1*VT( 2 )
T3 = T1*VT( 3 )
REFSUM = H( K+1, K ) + VT( 2 )*H( K+2, K )
*
IF( ABS( H( K+2, K )-REFSUM*VT( 2 ) )+
$ ABS( REFSUM*VT( 3 ) ).GT.ULP*
IF( ABS( H( K+2, K )-REFSUM*T2 )+
$ ABS( REFSUM*T3 ).GT.ULP*
$ ( ABS( H( K, K ) )+ABS( H( K+1,
$ K+1 ) )+ABS( H( K+2, K+2 ) ) ) ) THEN
*
Expand All @@ -619,7 +624,7 @@ SUBROUTINE DLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS,
* . Replace the old reflector with
* . the new one. ====
*
H( K+1, K ) = H( K+1, K ) - REFSUM
H( K+1, K ) = H( K+1, K ) - REFSUM*T1
H( K+2, K ) = ZERO
H( K+3, K ) = ZERO
V( 1, M ) = VT( 1 )
Expand Down
23 changes: 14 additions & 9 deletions SRC/slaqr5.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -558,10 +558,13 @@ SUBROUTINE SLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS,
* . Mth bulge. Exploit fact that first two elements
* . of row are actually zero. ====
*
REFSUM = V( 1, M )*V( 3, M )*H( K+3, K+2 )
H( K+3, K ) = -REFSUM
H( K+3, K+1 ) = -REFSUM*V( 2, M )
H( K+3, K+2 ) = H( K+3, K+2 ) - REFSUM*V( 3, M )
T1 = V( 1, M )
T2 = T1*V( 2, M )
T3 = T1*V( 3, M )
REFSUM = V( 3, M )*H( K+3, K+2 )
H( K+3, K ) = -REFSUM*T1
H( K+3, K+1 ) = -REFSUM*T2
H( K+3, K+2 ) = H( K+3, K+2 ) - REFSUM*T3
*
* ==== Calculate reflection to move
* . Mth bulge one step. ====
Expand Down Expand Up @@ -597,11 +600,13 @@ SUBROUTINE SLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS,
$ VT )
ALPHA = VT( 1 )
CALL SLARFG( 3, ALPHA, VT( 2 ), 1, VT( 1 ) )
REFSUM = VT( 1 )*( H( K+1, K )+VT( 2 )*
$ H( K+2, K ) )
T1 = VT( 1 )
T2 = T1*VT( 2 )
T3 = T2*VT( 3 )
REFSUM = H( K+1, K )+VT( 2 )*H( K+2, K )
*
IF( ABS( H( K+2, K )-REFSUM*VT( 2 ) )+
$ ABS( REFSUM*VT( 3 ) ).GT.ULP*
IF( ABS( H( K+2, K )-REFSUM*T2 )+
$ ABS( REFSUM*T3 ).GT.ULP*
$ ( ABS( H( K, K ) )+ABS( H( K+1,
$ K+1 ) )+ABS( H( K+2, K+2 ) ) ) ) THEN
*
Expand All @@ -619,7 +624,7 @@ SUBROUTINE SLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS,
* . Replace the old reflector with
* . the new one. ====
*
H( K+1, K ) = H( K+1, K ) - REFSUM
H( K+1, K ) = H( K+1, K ) - REFSUM*T1
H( K+2, K ) = ZERO
H( K+3, K ) = ZERO
V( 1, M ) = VT( 1 )
Expand Down
25 changes: 14 additions & 11 deletions SRC/zlaqr5.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -533,11 +533,13 @@ SUBROUTINE ZLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS, S,
* . Mth bulge. Exploit fact that first two elements
* . of row are actually zero. ====
*
REFSUM = V( 1, M )*V( 3, M )*H( K+3, K+2 )
H( K+3, K ) = -REFSUM
H( K+3, K+1 ) = -REFSUM*DCONJG( V( 2, M ) )
H( K+3, K+2 ) = H( K+3, K+2 ) -
$ REFSUM*DCONJG( V( 3, M ) )
T1 = V( 1, M )
T2 = T1*DCONJG( V( 2, M ) )
T3 = T1*DCONJG( V( 3, M ) )
REFSUM = V( 3, M )*H( K+3, K+2 )
H( K+3, K ) = -REFSUM*T1
H( K+3, K+1 ) = -REFSUM*T2
H( K+3, K+2 ) = H( K+3, K+2 ) - REFSUM*T3
*
* ==== Calculate reflection to move
* . Mth bulge one step. ====
Expand Down Expand Up @@ -572,12 +574,13 @@ SUBROUTINE ZLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS, S,
$ S( 2*M ), VT )
ALPHA = VT( 1 )
CALL ZLARFG( 3, ALPHA, VT( 2 ), 1, VT( 1 ) )
REFSUM = DCONJG( VT( 1 ) )*
$ ( H( K+1, K )+DCONJG( VT( 2 ) )*
$ H( K+2, K ) )
T1 = DCONJG( VT( 1 ) )
T2 = T1*VT( 2 )
T3 = T1*VT( 3 )
REFSUM = H( K+1, K )+DCONJG( VT( 2 ) )*H( K+2, K )
*
IF( CABS1( H( K+2, K )-REFSUM*VT( 2 ) )+
$ CABS1( REFSUM*VT( 3 ) ).GT.ULP*
IF( CABS1( H( K+2, K )-REFSUM*T2 )+
$ CABS1( REFSUM*T3 ).GT.ULP*
$ ( CABS1( H( K, K ) )+CABS1( H( K+1,
$ K+1 ) )+CABS1( H( K+2, K+2 ) ) ) ) THEN
*
Expand All @@ -595,7 +598,7 @@ SUBROUTINE ZLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS, S,
* . Replace the old reflector with
* . the new one. ====
*
H( K+1, K ) = H( K+1, K ) - REFSUM
H( K+1, K ) = H( K+1, K ) - REFSUM*T1
H( K+2, K ) = ZERO
H( K+3, K ) = ZERO
V( 1, M ) = VT( 1 )
Expand Down