Skip to content

Commit b4873c1

Browse files
thijssteelthijssteel
committed
i remember thinking to myself, i don't need to handle this case, it should never happen... i was wrong
1 parent d272841 commit b4873c1

File tree

4 files changed

+129
-117
lines changed

4 files changed

+129
-117
lines changed

‎SRC/claqr5.f

Lines changed: 33 additions & 31 deletions
Original file line numberDiff line numberDiff line change
@@ -462,37 +462,39 @@ SUBROUTINE CLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS, S,
462462
* . is zero (as done here) is traditional but probably
463463
* . unnecessary. ====
464464
*
465-
IF( H( K+1, K ).NE.ZERO ) THEN
466-
TST1 = CABS1( H( K, K ) ) + CABS1( H( K+1, K+1 ) )
467-
IF( TST1.EQ.RZERO ) THEN
468-
IF( K.GE.KTOP+1 )
469-
$ TST1 = TST1 + CABS1( H( K, K-1 ) )
470-
IF( K.GE.KTOP+2 )
471-
$ TST1 = TST1 + CABS1( H( K, K-2 ) )
472-
IF( K.GE.KTOP+3 )
473-
$ TST1 = TST1 + CABS1( H( K, K-3 ) )
474-
IF( K.LE.KBOT-2 )
475-
$ TST1 = TST1 + CABS1( H( K+2, K+1 ) )
476-
IF( K.LE.KBOT-3 )
477-
$ TST1 = TST1 + CABS1( H( K+3, K+1 ) )
478-
IF( K.LE.KBOT-4 )
479-
$ TST1 = TST1 + CABS1( H( K+4, K+1 ) )
480-
END IF
481-
IF( CABS1( H( K+1, K ) ).LE.MAX( SMLNUM, ULP*TST1 ) )
482-
$ THEN
483-
H12 = MAX( CABS1( H( K+1, K ) ),
484-
$ CABS1( H( K, K+1 ) ) )
485-
H21 = MIN( CABS1( H( K+1, K ) ),
486-
$ CABS1( H( K, K+1 ) ) )
487-
H11 = MAX( CABS1( H( K+1, K+1 ) ),
488-
$ CABS1( H( K, K )-H( K+1, K+1 ) ) )
489-
H22 = MIN( CABS1( H( K+1, K+1 ) ),
490-
$ CABS1( H( K, K )-H( K+1, K+1 ) ) )
491-
SCL = H11 + H12
492-
TST2 = H22*( H11 / SCL )
493-
*
494-
IF( TST2.EQ.RZERO .OR. H21*( H12 / SCL ).LE.
495-
$ MAX( SMLNUM, ULP*TST2 ) )H( K+1, K ) = ZERO
465+
IF( K.GE.KTOP) THEN
466+
IF( H( K+1, K ).NE.ZERO ) THEN
467+
TST1 = CABS1( H( K, K ) ) + CABS1( H( K+1, K+1 ) )
468+
IF( TST1.EQ.RZERO ) THEN
469+
IF( K.GE.KTOP+1 )
470+
$ TST1 = TST1 + CABS1( H( K, K-1 ) )
471+
IF( K.GE.KTOP+2 )
472+
$ TST1 = TST1 + CABS1( H( K, K-2 ) )
473+
IF( K.GE.KTOP+3 )
474+
$ TST1 = TST1 + CABS1( H( K, K-3 ) )
475+
IF( K.LE.KBOT-2 )
476+
$ TST1 = TST1 + CABS1( H( K+2, K+1 ) )
477+
IF( K.LE.KBOT-3 )
478+
$ TST1 = TST1 + CABS1( H( K+3, K+1 ) )
479+
IF( K.LE.KBOT-4 )
480+
$ TST1 = TST1 + CABS1( H( K+4, K+1 ) )
481+
END IF
482+
IF( CABS1( H( K+1, K ) )
483+
$ .LE.MAX( SMLNUM, ULP*TST1 ) ) THEN
484+
H12 = MAX( CABS1( H( K+1, K ) ),
485+
$ CABS1( H( K, K+1 ) ) )
486+
H21 = MIN( CABS1( H( K+1, K ) ),
487+
$ CABS1( H( K, K+1 ) ) )
488+
H11 = MAX( CABS1( H( K+1, K+1 ) ),
489+
$ CABS1( H( K, K )-H( K+1, K+1 ) ) )
490+
H22 = MIN( CABS1( H( K+1, K+1 ) ),
491+
$ CABS1( H( K, K )-H( K+1, K+1 ) ) )
492+
SCL = H11 + H12
493+
TST2 = H22*( H11 / SCL )
494+
*
495+
IF( TST2.EQ.RZERO .OR. H21*( H12 / SCL ).LE.
496+
$ MAX( SMLNUM, ULP*TST2 ) )H( K+1, K ) = ZERO
497+
END IF
496498
END IF
497499
END IF
498500
*

‎SRC/dlaqr5.f

Lines changed: 34 additions & 30 deletions
Original file line numberDiff line numberDiff line change
@@ -483,36 +483,40 @@ SUBROUTINE DLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS,
483483
* . is zero (as done here) is traditional but probably
484484
* . unnecessary. ====
485485
*
486-
IF( K.GE.KTOP .AND. H( K+1, K ).NE.ZERO ) THEN
487-
TST1 = ABS( H( K, K ) ) + ABS( H( K+1, K+1 ) )
488-
IF( TST1.EQ.ZERO ) THEN
489-
IF( K.GE.KTOP+1 )
490-
$ TST1 = TST1 + ABS( H( K, K-1 ) )
491-
IF( K.GE.KTOP+2 )
492-
$ TST1 = TST1 + ABS( H( K, K-2 ) )
493-
IF( K.GE.KTOP+3 )
494-
$ TST1 = TST1 + ABS( H( K, K-3 ) )
495-
IF( K.LE.KBOT-2 )
496-
$ TST1 = TST1 + ABS( H( K+2, K+1 ) )
497-
IF( K.LE.KBOT-3 )
498-
$ TST1 = TST1 + ABS( H( K+3, K+1 ) )
499-
IF( K.LE.KBOT-4 )
500-
$ TST1 = TST1 + ABS( H( K+4, K+1 ) )
501-
END IF
502-
IF( ABS( H( K+1, K ) ).LE.MAX( SMLNUM, ULP*TST1 ) )
503-
$ THEN
504-
H12 = MAX( ABS( H( K+1, K ) ), ABS( H( K, K+1 ) ) )
505-
H21 = MIN( ABS( H( K+1, K ) ), ABS( H( K, K+1 ) ) )
506-
H11 = MAX( ABS( H( K+1, K+1 ) ),
507-
$ ABS( H( K, K )-H( K+1, K+1 ) ) )
508-
H22 = MIN( ABS( H( K+1, K+1 ) ),
509-
$ ABS( H( K, K )-H( K+1, K+1 ) ) )
510-
SCL = H11 + H12
511-
TST2 = H22*( H11 / SCL )
512-
*
513-
IF( TST2.EQ.ZERO .OR. H21*( H12 / SCL ).LE.
514-
$ MAX( SMLNUM, ULP*TST2 ) ) THEN
515-
H( K+1, K ) = ZERO
486+
IF( K.GE.KTOP ) THEN
487+
IF( H( K+1, K ).NE.ZERO ) THEN
488+
TST1 = ABS( H( K, K ) ) + ABS( H( K+1, K+1 ) )
489+
IF( TST1.EQ.ZERO ) THEN
490+
IF( K.GE.KTOP+1 )
491+
$ TST1 = TST1 + ABS( H( K, K-1 ) )
492+
IF( K.GE.KTOP+2 )
493+
$ TST1 = TST1 + ABS( H( K, K-2 ) )
494+
IF( K.GE.KTOP+3 )
495+
$ TST1 = TST1 + ABS( H( K, K-3 ) )
496+
IF( K.LE.KBOT-2 )
497+
$ TST1 = TST1 + ABS( H( K+2, K+1 ) )
498+
IF( K.LE.KBOT-3 )
499+
$ TST1 = TST1 + ABS( H( K+3, K+1 ) )
500+
IF( K.LE.KBOT-4 )
501+
$ TST1 = TST1 + ABS( H( K+4, K+1 ) )
502+
END IF
503+
IF( ABS( H( K+1, K ) )
504+
$ .LE.MAX( SMLNUM, ULP*TST1 ) ) THEN
505+
H12 = MAX( ABS( H( K+1, K ) ),
506+
$ ABS( H( K, K+1 ) ) )
507+
H21 = MIN( ABS( H( K+1, K ) ),
508+
$ ABS( H( K, K+1 ) ) )
509+
H11 = MAX( ABS( H( K+1, K+1 ) ),
510+
$ ABS( H( K, K )-H( K+1, K+1 ) ) )
511+
H22 = MIN( ABS( H( K+1, K+1 ) ),
512+
$ ABS( H( K, K )-H( K+1, K+1 ) ) )
513+
SCL = H11 + H12
514+
TST2 = H22*( H11 / SCL )
515+
*
516+
IF( TST2.EQ.ZERO .OR. H21*( H12 / SCL ).LE.
517+
$ MAX( SMLNUM, ULP*TST2 ) ) THEN
518+
H( K+1, K ) = ZERO
519+
END IF
516520
END IF
517521
END IF
518522
END IF

‎SRC/slaqr5.f

Lines changed: 34 additions & 30 deletions
Original file line numberDiff line numberDiff line change
@@ -483,36 +483,40 @@ SUBROUTINE SLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS,
483483
* . is zero (as done here) is traditional but probably
484484
* . unnecessary. ====
485485
*
486-
IF( K.GE.KTOP .AND. H( K+1, K ).NE.ZERO ) THEN
487-
TST1 = ABS( H( K, K ) ) + ABS( H( K+1, K+1 ) )
488-
IF( TST1.EQ.ZERO ) THEN
489-
IF( K.GE.KTOP+1 )
490-
$ TST1 = TST1 + ABS( H( K, K-1 ) )
491-
IF( K.GE.KTOP+2 )
492-
$ TST1 = TST1 + ABS( H( K, K-2 ) )
493-
IF( K.GE.KTOP+3 )
494-
$ TST1 = TST1 + ABS( H( K, K-3 ) )
495-
IF( K.LE.KBOT-2 )
496-
$ TST1 = TST1 + ABS( H( K+2, K+1 ) )
497-
IF( K.LE.KBOT-3 )
498-
$ TST1 = TST1 + ABS( H( K+3, K+1 ) )
499-
IF( K.LE.KBOT-4 )
500-
$ TST1 = TST1 + ABS( H( K+4, K+1 ) )
501-
END IF
502-
IF( ABS( H( K+1, K ) ).LE.MAX( SMLNUM, ULP*TST1 ) )
503-
$ THEN
504-
H12 = MAX( ABS( H( K+1, K ) ), ABS( H( K, K+1 ) ) )
505-
H21 = MIN( ABS( H( K+1, K ) ), ABS( H( K, K+1 ) ) )
506-
H11 = MAX( ABS( H( K+1, K+1 ) ),
507-
$ ABS( H( K, K )-H( K+1, K+1 ) ) )
508-
H22 = MIN( ABS( H( K+1, K+1 ) ),
509-
$ ABS( H( K, K )-H( K+1, K+1 ) ) )
510-
SCL = H11 + H12
511-
TST2 = H22*( H11 / SCL )
512-
*
513-
IF( TST2.EQ.ZERO .OR. H21*( H12 / SCL ).LE.
514-
$ MAX( SMLNUM, ULP*TST2 ) ) THEN
515-
H( K+1, K ) = ZERO
486+
IF( K.GE.KTOP ) THEN
487+
IF( H( K+1, K ).NE.ZERO ) THEN
488+
TST1 = ABS( H( K, K ) ) + ABS( H( K+1, K+1 ) )
489+
IF( TST1.EQ.ZERO ) THEN
490+
IF( K.GE.KTOP+1 )
491+
$ TST1 = TST1 + ABS( H( K, K-1 ) )
492+
IF( K.GE.KTOP+2 )
493+
$ TST1 = TST1 + ABS( H( K, K-2 ) )
494+
IF( K.GE.KTOP+3 )
495+
$ TST1 = TST1 + ABS( H( K, K-3 ) )
496+
IF( K.LE.KBOT-2 )
497+
$ TST1 = TST1 + ABS( H( K+2, K+1 ) )
498+
IF( K.LE.KBOT-3 )
499+
$ TST1 = TST1 + ABS( H( K+3, K+1 ) )
500+
IF( K.LE.KBOT-4 )
501+
$ TST1 = TST1 + ABS( H( K+4, K+1 ) )
502+
END IF
503+
IF( ABS( H( K+1, K ) ).LE.MAX( SMLNUM, ULP*TST1 ) )
504+
$ THEN
505+
H12 = MAX( ABS( H( K+1, K ) ),
506+
$ ABS( H( K, K+1 ) ) )
507+
H21 = MIN( ABS( H( K+1, K ) ),
508+
$ ABS( H( K, K+1 ) ) )
509+
H11 = MAX( ABS( H( K+1, K+1 ) ),
510+
$ ABS( H( K, K )-H( K+1, K+1 ) ) )
511+
H22 = MIN( ABS( H( K+1, K+1 ) ),
512+
$ ABS( H( K, K )-H( K+1, K+1 ) ) )
513+
SCL = H11 + H12
514+
TST2 = H22*( H11 / SCL )
515+
*
516+
IF( TST2.EQ.ZERO .OR. H21*( H12 / SCL ).LE.
517+
$ MAX( SMLNUM, ULP*TST2 ) ) THEN
518+
H( K+1, K ) = ZERO
519+
END IF
516520
END IF
517521
END IF
518522
END IF

‎SRC/zlaqr5.f

Lines changed: 28 additions & 26 deletions
Original file line numberDiff line numberDiff line change
@@ -462,37 +462,39 @@ SUBROUTINE ZLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS, S,
462462
* . is zero (as done here) is traditional but probably
463463
* . unnecessary. ====
464464
*
465-
IF( H( K+1, K ).NE.ZERO ) THEN
466-
TST1 = CABS1( H( K, K ) ) + CABS1( H( K+1, K+1 ) )
467-
IF( TST1.EQ.RZERO ) THEN
468-
IF( K.GE.KTOP+1 )
469-
$ TST1 = TST1 + CABS1( H( K, K-1 ) )
470-
IF( K.GE.KTOP+2 )
471-
$ TST1 = TST1 + CABS1( H( K, K-2 ) )
472-
IF( K.GE.KTOP+3 )
473-
$ TST1 = TST1 + CABS1( H( K, K-3 ) )
474-
IF( K.LE.KBOT-2 )
475-
$ TST1 = TST1 + CABS1( H( K+2, K+1 ) )
476-
IF( K.LE.KBOT-3 )
477-
$ TST1 = TST1 + CABS1( H( K+3, K+1 ) )
478-
IF( K.LE.KBOT-4 )
479-
$ TST1 = TST1 + CABS1( H( K+4, K+1 ) )
480-
END IF
481-
IF( CABS1( H( K+1, K ) ).LE.MAX( SMLNUM, ULP*TST1 ) )
482-
$ THEN
483-
H12 = MAX( CABS1( H( K+1, K ) ),
465+
IF( K.GE.KTOP ) THEN
466+
IF( H( K+1, K ).NE.ZERO ) THEN
467+
TST1 = CABS1( H( K, K ) ) + CABS1( H( K+1, K+1 ) )
468+
IF( TST1.EQ.RZERO ) THEN
469+
IF( K.GE.KTOP+1 )
470+
$ TST1 = TST1 + CABS1( H( K, K-1 ) )
471+
IF( K.GE.KTOP+2 )
472+
$ TST1 = TST1 + CABS1( H( K, K-2 ) )
473+
IF( K.GE.KTOP+3 )
474+
$ TST1 = TST1 + CABS1( H( K, K-3 ) )
475+
IF( K.LE.KBOT-2 )
476+
$ TST1 = TST1 + CABS1( H( K+2, K+1 ) )
477+
IF( K.LE.KBOT-3 )
478+
$ TST1 = TST1 + CABS1( H( K+3, K+1 ) )
479+
IF( K.LE.KBOT-4 )
480+
$ TST1 = TST1 + CABS1( H( K+4, K+1 ) )
481+
END IF
482+
IF( CABS1( H( K+1, K ) )
483+
$ .LE.MAX( SMLNUM, ULP*TST1 ) ) THEN
484+
H12 = MAX( CABS1( H( K+1, K ) ),
484485
$ CABS1( H( K, K+1 ) ) )
485-
H21 = MIN( CABS1( H( K+1, K ) ),
486+
H21 = MIN( CABS1( H( K+1, K ) ),
486487
$ CABS1( H( K, K+1 ) ) )
487-
H11 = MAX( CABS1( H( K+1, K+1 ) ),
488+
H11 = MAX( CABS1( H( K+1, K+1 ) ),
488489
$ CABS1( H( K, K )-H( K+1, K+1 ) ) )
489-
H22 = MIN( CABS1( H( K+1, K+1 ) ),
490+
H22 = MIN( CABS1( H( K+1, K+1 ) ),
490491
$ CABS1( H( K, K )-H( K+1, K+1 ) ) )
491-
SCL = H11 + H12
492-
TST2 = H22*( H11 / SCL )
492+
SCL = H11 + H12
493+
TST2 = H22*( H11 / SCL )
493494
*
494-
IF( TST2.EQ.RZERO .OR. H21*( H12 / SCL ).LE.
495-
$ MAX( SMLNUM, ULP*TST2 ) )H( K+1, K ) = ZERO
495+
IF( TST2.EQ.RZERO .OR. H21*( H12 / SCL ).LE.
496+
$ MAX( SMLNUM, ULP*TST2 ) )H( K+1, K ) = ZERO
497+
END IF
496498
END IF
497499
END IF
498500
*

0 commit comments

Comments
 (0)