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

Merge pull request #3211 from martin-frbg/lapack471 

Handle norm NaN value in xGESDD (Reference LAPACK PR471)
This commit is contained in:
Martin Kroeker 2021-05-02 18:44:29 +02:00 committed by GitHub
parent 37d3e2bd94 d77d9bc920
commit b67a92c19f
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
4 changed files with 24 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
lapack-netlib/SRC/cgesdd.f
View File

@ -281,9 +281,9 @@
$ CUNGQR, CUNMBR, SBDSDC, SLASCL, XERBLA $ CUNGQR, CUNMBR, SBDSDC, SLASCL, XERBLA
* .. * ..
* .. External Functions .. * .. External Functions ..
LOGICAL LSAME LOGICAL LSAME, SISNAN
REAL SLAMCH, CLANGE REAL SLAMCH, CLANGE
EXTERNAL LSAME, SLAMCH, CLANGE EXTERNAL LSAME, SLAMCH, CLANGE, SISNAN
* .. * ..
* .. Intrinsic Functions .. * .. Intrinsic Functions ..
INTRINSIC INT, MAX, MIN, SQRT INTRINSIC INT, MAX, MIN, SQRT
@ -647,6 +647,10 @@
* Scale A if max element outside range [SMLNUM,BIGNUM] * Scale A if max element outside range [SMLNUM,BIGNUM]
* *
ANRM = CLANGE( 'M', M, N, A, LDA, DUM ) ANRM = CLANGE( 'M', M, N, A, LDA, DUM )
IF( SISNAN ( ANRM ) ) THEN
INFO = -4
RETURN
END IF
ISCL = 0 ISCL = 0
IF( ANRM.GT.ZERO .AND. ANRM.LT.SMLNUM ) THEN IF( ANRM.GT.ZERO .AND. ANRM.LT.SMLNUM ) THEN
ISCL = 1 ISCL = 1

8
lapack-netlib/SRC/dgesdd.f
View File

@ -267,9 +267,9 @@
$ XERBLA $ XERBLA
* .. * ..
* .. External Functions .. * .. External Functions ..
LOGICAL LSAME LOGICAL LSAME, DISNAN
DOUBLE PRECISION DLAMCH, DLANGE DOUBLE PRECISION DLAMCH, DLANGE
EXTERNAL DLAMCH, DLANGE, LSAME EXTERNAL DLAMCH, DLANGE, LSAME, DISNAN
* .. * ..
* .. Intrinsic Functions .. * .. Intrinsic Functions ..
INTRINSIC INT, MAX, MIN, SQRT INTRINSIC INT, MAX, MIN, SQRT
@ -599,6 +599,10 @@
* Scale A if max element outside range [SMLNUM,BIGNUM] * Scale A if max element outside range [SMLNUM,BIGNUM]
* *
ANRM = DLANGE( 'M', M, N, A, LDA, DUM ) ANRM = DLANGE( 'M', M, N, A, LDA, DUM )
IF( DISNAN( ANRM ) ) THEN
INFO = -4
RETURN
END IF
ISCL = 0 ISCL = 0
IF( ANRM.GT.ZERO .AND. ANRM.LT.SMLNUM ) THEN IF( ANRM.GT.ZERO .AND. ANRM.LT.SMLNUM ) THEN
ISCL = 1 ISCL = 1

8
lapack-netlib/SRC/sgesdd.f
View File

@ -267,9 +267,9 @@
$ XERBLA $ XERBLA
* .. * ..
* .. External Functions .. * .. External Functions ..
LOGICAL LSAME LOGICAL LSAME, SISNAN
REAL SLAMCH, SLANGE REAL SLAMCH, SLANGE
EXTERNAL SLAMCH, SLANGE, LSAME EXTERNAL SLAMCH, SLANGE, LSAME, SISNAN
* .. * ..
* .. Intrinsic Functions .. * .. Intrinsic Functions ..
INTRINSIC INT, MAX, MIN, SQRT INTRINSIC INT, MAX, MIN, SQRT
@ -599,6 +599,10 @@
* Scale A if max element outside range [SMLNUM,BIGNUM] * Scale A if max element outside range [SMLNUM,BIGNUM]
* *
ANRM = SLANGE( 'M', M, N, A, LDA, DUM ) ANRM = SLANGE( 'M', M, N, A, LDA, DUM )
IF( SISNAN( ANRM ) ) THEN
INFO = -4
RETURN
END IF
ISCL = 0 ISCL = 0
IF( ANRM.GT.ZERO .AND. ANRM.LT.SMLNUM ) THEN IF( ANRM.GT.ZERO .AND. ANRM.LT.SMLNUM ) THEN
ISCL = 1 ISCL = 1

8
lapack-netlib/SRC/zgesdd.f
View File

@ -281,9 +281,9 @@
$ ZLASET, ZUNGBR, ZUNGLQ, ZUNGQR, ZUNMBR $ ZLASET, ZUNGBR, ZUNGLQ, ZUNGQR, ZUNMBR
* .. * ..
* .. External Functions .. * .. External Functions ..
LOGICAL LSAME LOGICAL LSAME, DISNAN
DOUBLE PRECISION DLAMCH, ZLANGE DOUBLE PRECISION DLAMCH, ZLANGE
EXTERNAL LSAME, DLAMCH, ZLANGE EXTERNAL LSAME, DLAMCH, ZLANGE, DISNAN
* .. * ..
* .. Intrinsic Functions .. * .. Intrinsic Functions ..
INTRINSIC INT, MAX, MIN, SQRT INTRINSIC INT, MAX, MIN, SQRT
@ -647,6 +647,10 @@
* Scale A if max element outside range [SMLNUM,BIGNUM] * Scale A if max element outside range [SMLNUM,BIGNUM]
* *
ANRM = ZLANGE( 'M', M, N, A, LDA, DUM ) ANRM = ZLANGE( 'M', M, N, A, LDA, DUM )
IF( DISNAN( ANRM ) ) THEN
INFO = -4
RETURN
END IF
ISCL = 0 ISCL = 0
IF( ANRM.GT.ZERO .AND. ANRM.LT.SMLNUM ) THEN IF( ANRM.GT.ZERO .AND. ANRM.LT.SMLNUM ) THEN
ISCL = 1 ISCL = 1