Skip to content

Commit b1102fe

Browse files
martin-frbgmartin-frbg
authored
Merge pull request #3830 from martin-frbg/lapack691+698
Add quick return in ?LASCL; use normwise criterion for INF in QZ; fix workspace calcn for ?SYEVD (Reference-LAPACK PRs 674+691+698)
2 parents 1714d64 + 3f31b69 commit b1102fe

File tree

12 files changed

+20
-32
lines changed

12 files changed

+20
-32
lines changed

‎lapack-netlib/SRC/cheevd.f

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -284,7 +284,7 @@ SUBROUTINE CHEEVD( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, RWORK,
284284
LIWMIN = 1
285285
END IF
286286
LOPT = MAX( LWMIN, N +
287-
$ ILAENV( 1, 'CHETRD', UPLO, N, -1, -1, -1 ) )
287+
$ N*ILAENV( 1, 'CHETRD', UPLO, N, -1, -1, -1 ) )
288288
LROPT = LRWMIN
289289
LIOPT = LIWMIN
290290
END IF

‎lapack-netlib/SRC/chgeqz.f

Lines changed: 2 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -523,9 +523,7 @@ SUBROUTINE CHGEQZ( JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, LDT,
523523
END IF
524524
END IF
525525
*
526-
IF( ABS( T( ILAST, ILAST ) ).LE.MAX( SAFMIN, ULP*(
527-
$ ABS( T( ILAST - 1, ILAST ) ) + ABS( T( ILAST-1, ILAST-1 )
528-
$ ) ) ) ) THEN
526+
IF( ABS( T( ILAST, ILAST ) ).LE.BTOL ) THEN
529527
T( ILAST, ILAST ) = CZERO
530528
GO TO 50
531529
END IF
@@ -551,10 +549,7 @@ SUBROUTINE CHGEQZ( JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, LDT,
551549
*
552550
* Test 2: for T(j,j)=0
553551
*
554-
TEMP = ABS ( T( J, J + 1 ) )
555-
IF ( J .GT. ILO )
556-
$ TEMP = TEMP + ABS ( T( J - 1, J ) )
557-
IF( ABS( T( J, J ) ).LT.MAX( SAFMIN,ULP*TEMP ) ) THEN
552+
IF( ABS( T( J, J ) ).LT.BTOL ) THEN
558553
T( J, J ) = CZERO
559554
*
560555
* Test 1a: Check for 2 consecutive small subdiagonals in A

‎lapack-netlib/SRC/clascl.f

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -272,6 +272,8 @@ SUBROUTINE CLASCL( TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO )
272272
ELSE
273273
MUL = CTOC / CFROMC
274274
DONE = .TRUE.
275+
IF (MUL .EQ. ONE)
276+
$ RETURN
275277
END IF
276278
END IF
277279
*

‎lapack-netlib/SRC/dhgeqz.f

Lines changed: 2 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -536,9 +536,7 @@ SUBROUTINE DHGEQZ( JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, LDT,
536536
END IF
537537
END IF
538538
*
539-
IF( ABS( T( ILAST, ILAST ) ).LE.MAX( SAFMIN, ULP*(
540-
$ ABS( T( ILAST - 1, ILAST ) ) + ABS( T( ILAST-1, ILAST-1 )
541-
$ ) ) ) ) THEN
539+
IF( ABS( T( ILAST, ILAST ) ).LE.BTOL ) THEN
542540
T( ILAST, ILAST ) = ZERO
543541
GO TO 70
544542
END IF
@@ -564,10 +562,7 @@ SUBROUTINE DHGEQZ( JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, LDT,
564562
*
565563
* Test 2: for T(j,j)=0
566564
*
567-
TEMP = ABS ( T( J, J + 1 ) )
568-
IF ( J .GT. ILO )
569-
$ TEMP = TEMP + ABS ( T( J - 1, J ) )
570-
IF( ABS( T( J, J ) ).LT.MAX( SAFMIN,ULP*TEMP ) ) THEN
565+
IF( ABS( T( J, J ) ).LT.BTOL ) THEN
571566
T( J, J ) = ZERO
572567
*
573568
* Test 1a: Check for 2 consecutive small subdiagonals in A

‎lapack-netlib/SRC/dlascl.f

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -272,6 +272,8 @@ SUBROUTINE DLASCL( TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO )
272272
ELSE
273273
MUL = CTOC / CFROMC
274274
DONE = .TRUE.
275+
IF (MUL .EQ. ONE)
276+
$ RETURN
275277
END IF
276278
END IF
277279
*

‎lapack-netlib/SRC/dsyevd.f

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -257,7 +257,7 @@ SUBROUTINE DSYEVD( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, IWORK,
257257
LWMIN = 2*N + 1
258258
END IF
259259
LOPT = MAX( LWMIN, 2*N +
260-
$ ILAENV( 1, 'DSYTRD', UPLO, N, -1, -1, -1 ) )
260+
$ N*ILAENV( 1, 'DSYTRD', UPLO, N, -1, -1, -1 ) )
261261
LIOPT = LIWMIN
262262
END IF
263263
WORK( 1 ) = LOPT

‎lapack-netlib/SRC/shgeqz.f

Lines changed: 2 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -536,9 +536,7 @@ SUBROUTINE SHGEQZ( JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, LDT,
536536
END IF
537537
END IF
538538
*
539-
IF( ABS( T( ILAST, ILAST ) ).LE.MAX( SAFMIN, ULP*(
540-
$ ABS( T( ILAST - 1, ILAST ) ) + ABS( T( ILAST-1, ILAST-1 )
541-
$ ) ) ) ) THEN
539+
IF( ABS( T( ILAST, ILAST ) ).LE.BTOL ) THEN
542540
T( ILAST, ILAST ) = ZERO
543541
GO TO 70
544542
END IF
@@ -564,10 +562,7 @@ SUBROUTINE SHGEQZ( JOB, COMPQ, COMPZ, N, ILO, IHI, H, LDH, T, LDT,
564562
*
565563
* Test 2: for T(j,j)=0
566564
*
567-
TEMP = ABS ( T( J, J + 1 ) )
568-
IF ( J .GT. ILO )
569-
$ TEMP = TEMP + ABS ( T( J - 1, J ) )
570-
IF( ABS( T( J, J ) ).LT.MAX( SAFMIN,ULP*TEMP ) ) THEN
565+
IF( ABS( T( J, J ) ).LT.BTOL ) THEN
571566
T( J, J ) = ZERO
572567
*
573568
* Test 1a: Check for 2 consecutive small subdiagonals in A

‎lapack-netlib/SRC/slascl.f

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -272,6 +272,8 @@ SUBROUTINE SLASCL( TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO )
272272
ELSE
273273
MUL = CTOC / CFROMC
274274
DONE = .TRUE.
275+
IF (MUL .EQ. ONE)
276+
$ RETURN
275277
END IF
276278
END IF
277279
*

‎lapack-netlib/SRC/ssyevd.f

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -255,7 +255,7 @@ SUBROUTINE SSYEVD( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, IWORK,
255255
LWMIN = 2*N + 1
256256
END IF
257257
LOPT = MAX( LWMIN, 2*N +
258-
$ ILAENV( 1, 'SSYTRD', UPLO, N, -1, -1, -1 ) )
258+
$ N*ILAENV( 1, 'SSYTRD', UPLO, N, -1, -1, -1 ) )
259259
LIOPT = LIWMIN
260260
END IF
261261
WORK( 1 ) = LOPT

‎lapack-netlib/SRC/zheevd.f

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -284,7 +284,7 @@ SUBROUTINE ZHEEVD( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, RWORK,
284284
LIWMIN = 1
285285
END IF
286286
LOPT = MAX( LWMIN, N +
287-
$ ILAENV( 1, 'ZHETRD', UPLO, N, -1, -1, -1 ) )
287+
$ N*ILAENV( 1, 'ZHETRD', UPLO, N, -1, -1, -1 ) )
288288
LROPT = LRWMIN
289289
LIOPT = LIWMIN
290290
END IF

0 commit comments

Comments
 (0)