floraachy
/
OpenBLAS
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

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)
This commit is contained in:
Martin Kroeker 2022-11-20 16:29:46 +01:00 committed by GitHub
parent 1714d640f1 3f31b69121
commit b1102fe250
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
12 changed files with 20 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
lapack-netlib/SRC/cheevd.f
View File

@ -284,7 +284,7 @@
LIWMIN = 1 LIWMIN = 1
END IF END IF
LOPT = MAX( LWMIN, N + LOPT = MAX( LWMIN, N +
$ ILAENV( 1, 'CHETRD', UPLO, N, -1, -1, -1 ) ) $ N*ILAENV( 1, 'CHETRD', UPLO, N, -1, -1, -1 ) )
LROPT = LRWMIN LROPT = LRWMIN
LIOPT = LIWMIN LIOPT = LIWMIN
END IF END IF

9
lapack-netlib/SRC/chgeqz.f
View File

@ -523,9 +523,7 @@
END IF END IF
END IF END IF
* *
IF( ABS( T( ILAST, ILAST ) ).LE.MAX( SAFMIN, ULP*( IF( ABS( T( ILAST, ILAST ) ).LE.BTOL ) THEN
$ ABS( T( ILAST - 1, ILAST ) ) + ABS( T( ILAST-1, ILAST-1 )
$ ) ) ) ) THEN
T( ILAST, ILAST ) = CZERO T( ILAST, ILAST ) = CZERO
GO TO 50 GO TO 50
END IF END IF
@ -551,10 +549,7 @@
* *
* Test 2: for T(j,j)=0 * Test 2: for T(j,j)=0
* *
TEMP = ABS ( T( J, J + 1 ) ) IF( ABS( T( J, J ) ).LT.BTOL ) THEN
IF ( J .GT. ILO )
$ TEMP = TEMP + ABS ( T( J - 1, J ) )
IF( ABS( T( J, J ) ).LT.MAX( SAFMIN,ULP*TEMP ) ) THEN
T( J, J ) = CZERO T( J, J ) = CZERO
* *
* Test 1a: Check for 2 consecutive small subdiagonals in A * Test 1a: Check for 2 consecutive small subdiagonals in A

2
lapack-netlib/SRC/clascl.f
View File

@ -272,6 +272,8 @@
ELSE ELSE
MUL = CTOC / CFROMC MUL = CTOC / CFROMC
DONE = .TRUE. DONE = .TRUE.
IF (MUL .EQ. ONE)
$ RETURN
END IF END IF
END IF END IF
* *

9
lapack-netlib/SRC/dhgeqz.f
View File

@ -536,9 +536,7 @@
END IF END IF
END IF END IF
* *
IF( ABS( T( ILAST, ILAST ) ).LE.MAX( SAFMIN, ULP*( IF( ABS( T( ILAST, ILAST ) ).LE.BTOL ) THEN
$ ABS( T( ILAST - 1, ILAST ) ) + ABS( T( ILAST-1, ILAST-1 )
$ ) ) ) ) THEN
T( ILAST, ILAST ) = ZERO T( ILAST, ILAST ) = ZERO
GO TO 70 GO TO 70
END IF END IF
@ -564,10 +562,7 @@
* *
* Test 2: for T(j,j)=0 * Test 2: for T(j,j)=0
* *
TEMP = ABS ( T( J, J + 1 ) ) IF( ABS( T( J, J ) ).LT.BTOL ) THEN
IF ( J .GT. ILO )
$ TEMP = TEMP + ABS ( T( J - 1, J ) )
IF( ABS( T( J, J ) ).LT.MAX( SAFMIN,ULP*TEMP ) ) THEN
T( J, J ) = ZERO T( J, J ) = ZERO
* *
* Test 1a: Check for 2 consecutive small subdiagonals in A * Test 1a: Check for 2 consecutive small subdiagonals in A

2
lapack-netlib/SRC/dlascl.f
View File

@ -272,6 +272,8 @@
ELSE ELSE
MUL = CTOC / CFROMC MUL = CTOC / CFROMC
DONE = .TRUE. DONE = .TRUE.
IF (MUL .EQ. ONE)
$ RETURN
END IF END IF
END IF END IF
* *

2
lapack-netlib/SRC/dsyevd.f
View File

@ -257,7 +257,7 @@
LWMIN = 2*N + 1 LWMIN = 2*N + 1
END IF END IF
LOPT = MAX( LWMIN, 2*N + LOPT = MAX( LWMIN, 2*N +
$ ILAENV( 1, 'DSYTRD', UPLO, N, -1, -1, -1 ) ) $ N*ILAENV( 1, 'DSYTRD', UPLO, N, -1, -1, -1 ) )
LIOPT = LIWMIN LIOPT = LIWMIN
END IF END IF
WORK( 1 ) = LOPT WORK( 1 ) = LOPT

9
lapack-netlib/SRC/shgeqz.f
View File

@ -536,9 +536,7 @@
END IF END IF
END IF END IF
* *
IF( ABS( T( ILAST, ILAST ) ).LE.MAX( SAFMIN, ULP*( IF( ABS( T( ILAST, ILAST ) ).LE.BTOL ) THEN
$ ABS( T( ILAST - 1, ILAST ) ) + ABS( T( ILAST-1, ILAST-1 )
$ ) ) ) ) THEN
T( ILAST, ILAST ) = ZERO T( ILAST, ILAST ) = ZERO
GO TO 70 GO TO 70
END IF END IF
@ -564,10 +562,7 @@
* *
* Test 2: for T(j,j)=0 * Test 2: for T(j,j)=0
* *
TEMP = ABS ( T( J, J + 1 ) ) IF( ABS( T( J, J ) ).LT.BTOL ) THEN
IF ( J .GT. ILO )
$ TEMP = TEMP + ABS ( T( J - 1, J ) )
IF( ABS( T( J, J ) ).LT.MAX( SAFMIN,ULP*TEMP ) ) THEN
T( J, J ) = ZERO T( J, J ) = ZERO
* *
* Test 1a: Check for 2 consecutive small subdiagonals in A * Test 1a: Check for 2 consecutive small subdiagonals in A

2
lapack-netlib/SRC/slascl.f
View File

@ -272,6 +272,8 @@
ELSE ELSE
MUL = CTOC / CFROMC MUL = CTOC / CFROMC
DONE = .TRUE. DONE = .TRUE.
IF (MUL .EQ. ONE)
$ RETURN
END IF END IF
END IF END IF
* *

2
lapack-netlib/SRC/ssyevd.f
View File

@ -255,7 +255,7 @@
LWMIN = 2*N + 1 LWMIN = 2*N + 1
END IF END IF
LOPT = MAX( LWMIN, 2*N + LOPT = MAX( LWMIN, 2*N +
$ ILAENV( 1, 'SSYTRD', UPLO, N, -1, -1, -1 ) ) $ N*ILAENV( 1, 'SSYTRD', UPLO, N, -1, -1, -1 ) )
LIOPT = LIWMIN LIOPT = LIWMIN
END IF END IF
WORK( 1 ) = LOPT WORK( 1 ) = LOPT

2
lapack-netlib/SRC/zheevd.f
View File

@ -284,7 +284,7 @@
LIWMIN = 1 LIWMIN = 1
END IF END IF
LOPT = MAX( LWMIN, N + LOPT = MAX( LWMIN, N +
$ ILAENV( 1, 'ZHETRD', UPLO, N, -1, -1, -1 ) ) $ N*ILAENV( 1, 'ZHETRD', UPLO, N, -1, -1, -1 ) )
LROPT = LRWMIN LROPT = LRWMIN
LIOPT = LIWMIN LIOPT = LIWMIN
END IF END IF

9
lapack-netlib/SRC/zhgeqz.f
View File

@ -524,9 +524,7 @@
END IF END IF
END IF END IF
* *
IF( ABS( T( ILAST, ILAST ) ).LE.MAX( SAFMIN, ULP*( IF( ABS( T( ILAST, ILAST ) ).LE.BTOL ) THEN
$ ABS( T( ILAST - 1, ILAST ) ) + ABS( T( ILAST-1, ILAST-1 )
$ ) ) ) ) THEN
T( ILAST, ILAST ) = CZERO T( ILAST, ILAST ) = CZERO
GO TO 50 GO TO 50
END IF END IF
@ -552,10 +550,7 @@
* *
* Test 2: for T(j,j)=0 * Test 2: for T(j,j)=0
* *
TEMP = ABS ( T( J, J + 1 ) ) IF( ABS( T( J, J ) ).LT.BTOL ) THEN
IF ( J .GT. ILO )
$ TEMP = TEMP + ABS ( T( J - 1, J ) )
IF( ABS( T( J, J ) ).LT.MAX( SAFMIN,ULP*TEMP ) ) THEN
T( J, J ) = CZERO T( J, J ) = CZERO
* *
* Test 1a: Check for 2 consecutive small subdiagonals in A * Test 1a: Check for 2 consecutive small subdiagonals in A

2
lapack-netlib/SRC/zlascl.f
View File

@ -272,6 +272,8 @@
ELSE ELSE
MUL = CTOC / CFROMC MUL = CTOC / CFROMC
DONE = .TRUE. DONE = .TRUE.
IF (MUL .EQ. ONE)
$ RETURN
END IF END IF
END IF END IF
* *