Skip to content

Commit d453071

Browse files
thijssteelthijssteel
committed
improve deflation criterion in xhgeqz
1 parent 5123fe9 commit d453071

4 files changed

Lines changed: 52 additions & 16 deletions

File tree

‎SRC/chgeqz.f‎

Lines changed: 13 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -518,13 +518,17 @@ SUBROUTINE CHGEQZ( JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, LDT,
518518
IF( ILAST.EQ.ILO ) THEN
519519
GO TO 60
520520
ELSE
521-
IF( ABS1( H( ILAST, ILAST-1 ) ).LE.ATOL ) THEN
521+
IF( ABS1( H( ILAST, ILAST-1 ) ).LE.MAX( SAFMIN, ULP*(
522+
$ ABS1( H( ILAST, ILAST ) ) + ABS1( H( ILAST-1, ILAST-1 )
523+
$ ) ) ) ) THEN
522524
H( ILAST, ILAST-1 ) = CZERO
523525
GO TO 60
524526
END IF
525527
END IF
526528
*
527-
IF( ABS( T( ILAST, ILAST ) ).LE.BTOL ) THEN
529+
IF( ABS( T( ILAST, ILAST ) ).LE.MAX( SAFMIN, ULP*(
530+
$ ABS( T( ILAST - 1, ILAST ) ) + ABS( T( ILAST-1, ILAST-1 )
531+
$ ) ) ) ) THEN
528532
T( ILAST, ILAST ) = CZERO
529533
GO TO 50
530534
END IF
@@ -538,7 +542,9 @@ SUBROUTINE CHGEQZ( JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, LDT,
538542
IF( J.EQ.ILO ) THEN
539543
ILAZRO = .TRUE.
540544
ELSE
541-
IF( ABS1( H( J, J-1 ) ).LE.ATOL ) THEN
545+
IF( ABS1( H( J, J-1 ) ).LE.MAX( SAFMIN, ULP*(
546+
$ ABS1( H( J, J ) ) + ABS1( H( J-1, J-1 ) )
547+
$ ) ) ) THEN
542548
H( J, J-1 ) = CZERO
543549
ILAZRO = .TRUE.
544550
ELSE
@@ -548,7 +554,10 @@ SUBROUTINE CHGEQZ( JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, LDT,
548554
*
549555
* Test 2: for T(j,j)=0
550556
*
551-
IF( ABS( T( J, J ) ).LT.BTOL ) THEN
557+
TEMP = ABS ( T( J, J + 1 ) )
558+
IF ( J .GT. ILO )
559+
$ TEMP = TEMP + ABS ( T( J - 1, J ) )
560+
IF( ABS( T( J, J ) ).LT.MAX( SAFMIN,ULP*TEMP ) ) THEN
552561
T( J, J ) = CZERO
553562
*
554563
* Test 1a: Check for 2 consecutive small subdiagonals in A

‎SRC/dhgeqz.f‎

Lines changed: 13 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -531,13 +531,17 @@ SUBROUTINE DHGEQZ( JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, LDT,
531531
*
532532
GO TO 80
533533
ELSE
534-
IF( ABS( H( ILAST, ILAST-1 ) ).LE.ATOL ) THEN
534+
IF( ABS( H( ILAST, ILAST-1 ) ).LE.MAX( SAFMIN, ULP*(
535+
$ ABS( H( ILAST, ILAST ) ) + ABS( H( ILAST-1, ILAST-1 ) )
536+
$ ) ) ) THEN
535537
H( ILAST, ILAST-1 ) = ZERO
536538
GO TO 80
537539
END IF
538540
END IF
539541
*
540-
IF( ABS( T( ILAST, ILAST ) ).LE.BTOL ) THEN
542+
IF( ABS( T( ILAST, ILAST ) ).LE.MAX( SAFMIN, ULP*(
543+
$ ABS( T( ILAST - 1, ILAST ) ) + ABS( T( ILAST-1, ILAST-1 )
544+
$ ) ) ) ) THEN
541545
T( ILAST, ILAST ) = ZERO
542546
GO TO 70
543547
END IF
@@ -551,7 +555,9 @@ SUBROUTINE DHGEQZ( JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, LDT,
551555
IF( J.EQ.ILO ) THEN
552556
ILAZRO = .TRUE.
553557
ELSE
554-
IF( ABS( H( J, J-1 ) ).LE.ATOL ) THEN
558+
IF( ABS( H( J, J-1 ) ).LE.MAX( SAFMIN, ULP*(
559+
$ ABS( H( J, J ) ) + ABS( H( J-1, J-1 ) )
560+
$ ) ) ) THEN
555561
H( J, J-1 ) = ZERO
556562
ILAZRO = .TRUE.
557563
ELSE
@@ -561,7 +567,10 @@ SUBROUTINE DHGEQZ( JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, LDT,
561567
*
562568
* Test 2: for T(j,j)=0
563569
*
564-
IF( ABS( T( J, J ) ).LT.BTOL ) THEN
570+
TEMP = ABS ( T( J, J + 1 ) )
571+
IF ( J .GT. ILO )
572+
$ TEMP = TEMP + ABS ( T( J - 1, J ) )
573+
IF( ABS( T( J, J ) ).LT.MAX( SAFMIN,ULP*TEMP ) ) THEN
565574
T( J, J ) = ZERO
566575
*
567576
* Test 1a: Check for 2 consecutive small subdiagonals in A

‎SRC/shgeqz.f‎

Lines changed: 13 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -531,13 +531,17 @@ SUBROUTINE SHGEQZ( JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, LDT,
531531
*
532532
GO TO 80
533533
ELSE
534-
IF( ABS( H( ILAST, ILAST-1 ) ).LE.ATOL ) THEN
534+
IF( ABS( H( ILAST, ILAST-1 ) ).LE.MAX( SAFMIN, ULP*(
535+
$ ABS( H( ILAST, ILAST ) ) + ABS( H( ILAST-1, ILAST-1 ) )
536+
$ ) ) ) THEN
535537
H( ILAST, ILAST-1 ) = ZERO
536538
GO TO 80
537539
END IF
538540
END IF
539541
*
540-
IF( ABS( T( ILAST, ILAST ) ).LE.BTOL ) THEN
542+
IF( ABS( T( ILAST, ILAST ) ).LE.MAX( SAFMIN, ULP*(
543+
$ ABS( T( ILAST - 1, ILAST ) ) + ABS( T( ILAST-1, ILAST-1 )
544+
$ ) ) ) ) THEN
541545
T( ILAST, ILAST ) = ZERO
542546
GO TO 70
543547
END IF
@@ -551,7 +555,9 @@ SUBROUTINE SHGEQZ( JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, LDT,
551555
IF( J.EQ.ILO ) THEN
552556
ILAZRO = .TRUE.
553557
ELSE
554-
IF( ABS( H( J, J-1 ) ).LE.ATOL ) THEN
558+
IF( ABS( H( J, J-1 ) ).LE.MAX( SAFMIN, ULP*(
559+
$ ABS( H( J, J ) ) + ABS( H( J-1, J-1 ) )
560+
$ ) ) ) THEN
555561
H( J, J-1 ) = ZERO
556562
ILAZRO = .TRUE.
557563
ELSE
@@ -561,7 +567,10 @@ SUBROUTINE SHGEQZ( JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, LDT,
561567
*
562568
* Test 2: for T(j,j)=0
563569
*
564-
IF( ABS( T( J, J ) ).LT.BTOL ) THEN
570+
TEMP = ABS ( T( J, J + 1 ) )
571+
IF ( J .GT. ILO )
572+
$ TEMP = TEMP + ABS ( T( J - 1, J ) )
573+
IF( ABS( T( J, J ) ).LT.MAX( SAFMIN,ULP*TEMP ) ) THEN
565574
T( J, J ) = ZERO
566575
*
567576
* Test 1a: Check for 2 consecutive small subdiagonals in A

‎SRC/zhgeqz.f‎

Lines changed: 13 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -519,13 +519,17 @@ SUBROUTINE ZHGEQZ( JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, LDT,
519519
IF( ILAST.EQ.ILO ) THEN
520520
GO TO 60
521521
ELSE
522-
IF( ABS1( H( ILAST, ILAST-1 ) ).LE.ATOL ) THEN
522+
IF( ABS1( H( ILAST, ILAST-1 ) ).LE.MAX( SAFMIN, ULP*(
523+
$ ABS1( H( ILAST, ILAST ) ) + ABS1( H( ILAST-1, ILAST-1 )
524+
$ ) ) ) ) THEN
523525
H( ILAST, ILAST-1 ) = CZERO
524526
GO TO 60
525527
END IF
526528
END IF
527529
*
528-
IF( ABS( T( ILAST, ILAST ) ).LE.BTOL ) THEN
530+
IF( ABS( T( ILAST, ILAST ) ).LE.MAX( SAFMIN, ULP*(
531+
$ ABS( T( ILAST - 1, ILAST ) ) + ABS( T( ILAST-1, ILAST-1 )
532+
$ ) ) ) ) THEN
529533
T( ILAST, ILAST ) = CZERO
530534
GO TO 50
531535
END IF
@@ -539,7 +543,9 @@ SUBROUTINE ZHGEQZ( JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, LDT,
539543
IF( J.EQ.ILO ) THEN
540544
ILAZRO = .TRUE.
541545
ELSE
542-
IF( ABS1( H( J, J-1 ) ).LE.ATOL ) THEN
546+
IF( ABS1( H( J, J-1 ) ).LE.MAX( SAFMIN, ULP*(
547+
$ ABS1( H( J, J ) ) + ABS1( H( J-1, J-1 ) )
548+
$ ) ) ) THEN
543549
H( J, J-1 ) = CZERO
544550
ILAZRO = .TRUE.
545551
ELSE
@@ -549,7 +555,10 @@ SUBROUTINE ZHGEQZ( JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, LDT,
549555
*
550556
* Test 2: for T(j,j)=0
551557
*
552-
IF( ABS( T( J, J ) ).LT.BTOL ) THEN
558+
TEMP = ABS ( T( J, J + 1 ) )
559+
IF ( J .GT. ILO )
560+
$ TEMP = TEMP + ABS ( T( J - 1, J ) )
561+
IF( ABS( T( J, J ) ).LT.MAX( SAFMIN,ULP*TEMP ) ) THEN
553562
T( J, J ) = CZERO
554563
*
555564
* Test 1a: Check for 2 consecutive small subdiagonals in A

0 commit comments

Comments
 (0)