OSchip
/
OpenBLAS
Not watched
1
0
Fork 0
Code
Releases 66 Wiki evaluate Activity
Issues 0 Pull Requests 0 Datasets Model Cloudbrain HPC
Browse Source

Set scale early for robust triangular solvers (Reference-LAPACK PR712)

tags/v0.3.22^2
Martin Kroeker GitHub 3 years ago
parent
1d5a3aff0d
commit
31d2145988
No known key found for this signature in database GPG Key ID: 4AEE18F83AFDEB23
8 changed files with 278 additions and 40 deletions
Unified View
Diff Options
Show Stats Download Patch File Download Diff File
  1. +3
    -6
      lapack-netlib/SRC/clatbs.f
  2. +71
    -8
      lapack-netlib/SRC/clatrs.f
  3. +1
    -1
      lapack-netlib/SRC/dlatbs.f
  4. +64
    -5
      lapack-netlib/SRC/dlatrs.f
  5. +1
    -1
      lapack-netlib/SRC/slatbs.f
  6. +64
    -5
      lapack-netlib/SRC/slatrs.f
  7. +3
    -6
      lapack-netlib/SRC/zlatbs.f
  8. +71
    -8
      lapack-netlib/SRC/zlatrs.f

+ 3
- 6
lapack-netlib/SRC/clatbs.f View File

@@ -278,7 +278,7 @@
$ CDOTU, CLADIV $ CDOTU, CLADIV
* .. * ..
* .. External Subroutines .. * .. External Subroutines ..
EXTERNAL CAXPY, CSSCAL, CTBSV, SLABAD, SSCAL, XERBLA
EXTERNAL CAXPY, CSSCAL, CTBSV, SSCAL, XERBLA
* .. * ..
* .. Intrinsic Functions .. * .. Intrinsic Functions ..
INTRINSIC ABS, AIMAG, CMPLX, CONJG, MAX, MIN, REAL INTRINSIC ABS, AIMAG, CMPLX, CONJG, MAX, MIN, REAL
@@ -324,17 +324,14 @@
* *
* Quick return if possible * Quick return if possible
* *
SCALE = ONE
IF( N.EQ.0 ) IF( N.EQ.0 )
$ RETURN $ RETURN
* *
* Determine machine dependent parameters to control overflow. * Determine machine dependent parameters to control overflow.
* *
SMLNUM = SLAMCH( 'Safe minimum' )
BIGNUM = ONE / SMLNUM
CALL SLABAD( SMLNUM, BIGNUM )
SMLNUM = SMLNUM / SLAMCH( 'Precision' )
SMLNUM = SLAMCH( 'Safe minimum' ) / SLAMCH( 'Precision' )
BIGNUM = ONE / SMLNUM BIGNUM = ONE / SMLNUM
SCALE = ONE
* *
IF( LSAME( NORMIN, 'N' ) ) THEN IF( LSAME( NORMIN, 'N' ) ) THEN
* *


+ 71
- 8
lapack-netlib/SRC/clatrs.f View File

@@ -274,7 +274,7 @@
$ CDOTU, CLADIV $ CDOTU, CLADIV
* .. * ..
* .. External Subroutines .. * .. External Subroutines ..
EXTERNAL CAXPY, CSSCAL, CTRSV, SLABAD, SSCAL, XERBLA
EXTERNAL CAXPY, CSSCAL, CTRSV, SSCAL, XERBLA
* .. * ..
* .. Intrinsic Functions .. * .. Intrinsic Functions ..
INTRINSIC ABS, AIMAG, CMPLX, CONJG, MAX, MIN, REAL INTRINSIC ABS, AIMAG, CMPLX, CONJG, MAX, MIN, REAL
@@ -318,17 +318,14 @@
* *
* Quick return if possible * Quick return if possible
* *
SCALE = ONE
IF( N.EQ.0 ) IF( N.EQ.0 )
$ RETURN $ RETURN
* *
* Determine machine dependent parameters to control overflow. * Determine machine dependent parameters to control overflow.
* *
SMLNUM = SLAMCH( 'Safe minimum' )
BIGNUM = ONE / SMLNUM
CALL SLABAD( SMLNUM, BIGNUM )
SMLNUM = SMLNUM / SLAMCH( 'Precision' )
SMLNUM = SLAMCH( 'Safe minimum' ) / SLAMCH( 'Precision' )
BIGNUM = ONE / SMLNUM BIGNUM = ONE / SMLNUM
SCALE = ONE
* *
IF( LSAME( NORMIN, 'N' ) ) THEN IF( LSAME( NORMIN, 'N' ) ) THEN
* *
@@ -360,8 +357,74 @@
IF( TMAX.LE.BIGNUM*HALF ) THEN IF( TMAX.LE.BIGNUM*HALF ) THEN
TSCAL = ONE TSCAL = ONE
ELSE ELSE
TSCAL = HALF / ( SMLNUM*TMAX )
CALL SSCAL( N, TSCAL, CNORM, 1 )
*
* Avoid NaN generation if entries in CNORM exceed the
* overflow threshold
*
IF ( TMAX.LE.SLAMCH('Overflow') ) THEN
* Case 1: All entries in CNORM are valid floating-point numbers
TSCAL = HALF / ( SMLNUM*TMAX )
CALL SSCAL( N, TSCAL, CNORM, 1 )
ELSE
* Case 2: At least one column norm of A cannot be
* represented as a floating-point number. Find the
* maximum offdiagonal absolute value
* max( |Re(A(I,J))|, |Im(A(I,J)| ). If this entry is
* not +/- Infinity, use this value as TSCAL.
TMAX = ZERO
IF( UPPER ) THEN
*
* A is upper triangular.
*
DO J = 2, N
DO I = 1, J - 1
TMAX = MAX( TMAX, ABS( REAL( A( I, J ) ) ),
$ ABS( AIMAG(A ( I, J ) ) ) )
END DO
END DO
ELSE
*
* A is lower triangular.
*
DO J = 1, N - 1
DO I = J + 1, N
TMAX = MAX( TMAX, ABS( REAL( A( I, J ) ) ),
$ ABS( AIMAG(A ( I, J ) ) ) )
END DO
END DO
END IF
*
IF( TMAX.LE.SLAMCH('Overflow') ) THEN
TSCAL = ONE / ( SMLNUM*TMAX )
DO J = 1, N
IF( CNORM( J ).LE.SLAMCH('Overflow') ) THEN
CNORM( J ) = CNORM( J )*TSCAL
ELSE
* Recompute the 1-norm of each column without
* introducing Infinity in the summation.
TSCAL = TWO * TSCAL
CNORM( J ) = ZERO
IF( UPPER ) THEN
DO I = 1, J - 1
CNORM( J ) = CNORM( J ) +
$ TSCAL * CABS2( A( I, J ) )
END DO
ELSE
DO I = J + 1, N
CNORM( J ) = CNORM( J ) +
$ TSCAL * CABS2( A( I, J ) )
END DO
END IF
TSCAL = TSCAL * HALF
END IF
END DO
ELSE
* At least one entry of A is not a valid floating-point
* entry. Rely on TRSV to propagate Inf and NaN.
CALL CTRSV( UPLO, TRANS, DIAG, N, A, LDA, X, 1 )
RETURN
END IF
END IF
END IF END IF
* *
* Compute a bound on the computed solution vector to see if the * Compute a bound on the computed solution vector to see if the


+ 1
- 1
lapack-netlib/SRC/dlatbs.f View File

@@ -310,6 +310,7 @@
* *
* Quick return if possible * Quick return if possible
* *
SCALE = ONE
IF( N.EQ.0 ) IF( N.EQ.0 )
$ RETURN $ RETURN
* *
@@ -317,7 +318,6 @@
* *
SMLNUM = DLAMCH( 'Safe minimum' ) / DLAMCH( 'Precision' ) SMLNUM = DLAMCH( 'Safe minimum' ) / DLAMCH( 'Precision' )
BIGNUM = ONE / SMLNUM BIGNUM = ONE / SMLNUM
SCALE = ONE
* *
IF( LSAME( NORMIN, 'N' ) ) THEN IF( LSAME( NORMIN, 'N' ) ) THEN
* *


+ 64
- 5
lapack-netlib/SRC/dlatrs.f View File

@@ -264,8 +264,8 @@
* .. External Functions .. * .. External Functions ..
LOGICAL LSAME LOGICAL LSAME
INTEGER IDAMAX INTEGER IDAMAX
DOUBLE PRECISION DASUM, DDOT, DLAMCH
EXTERNAL LSAME, IDAMAX, DASUM, DDOT, DLAMCH
DOUBLE PRECISION DASUM, DDOT, DLAMCH, DLANGE
EXTERNAL LSAME, IDAMAX, DASUM, DDOT, DLAMCH, DLANGE
* .. * ..
* .. External Subroutines .. * .. External Subroutines ..
EXTERNAL DAXPY, DSCAL, DTRSV, XERBLA EXTERNAL DAXPY, DSCAL, DTRSV, XERBLA
@@ -304,6 +304,7 @@
* *
* Quick return if possible * Quick return if possible
* *
SCALE = ONE
IF( N.EQ.0 ) IF( N.EQ.0 )
$ RETURN $ RETURN
* *
@@ -311,7 +312,6 @@
* *
SMLNUM = DLAMCH( 'Safe minimum' ) / DLAMCH( 'Precision' ) SMLNUM = DLAMCH( 'Safe minimum' ) / DLAMCH( 'Precision' )
BIGNUM = ONE / SMLNUM BIGNUM = ONE / SMLNUM
SCALE = ONE
* *
IF( LSAME( NORMIN, 'N' ) ) THEN IF( LSAME( NORMIN, 'N' ) ) THEN
* *
@@ -343,8 +343,67 @@
IF( TMAX.LE.BIGNUM ) THEN IF( TMAX.LE.BIGNUM ) THEN
TSCAL = ONE TSCAL = ONE
ELSE ELSE
TSCAL = ONE / ( SMLNUM*TMAX )
CALL DSCAL( N, TSCAL, CNORM, 1 )
*
* Avoid NaN generation if entries in CNORM exceed the
* overflow threshold
*
IF( TMAX.LE.DLAMCH('Overflow') ) THEN
* Case 1: All entries in CNORM are valid floating-point numbers
TSCAL = ONE / ( SMLNUM*TMAX )
CALL DSCAL( N, TSCAL, CNORM, 1 )
ELSE
* Case 2: At least one column norm of A cannot be represented
* as floating-point number. Find the offdiagonal entry A( I, J )
* with the largest absolute value. If this entry is not +/- Infinity,
* use this value as TSCAL.
TMAX = ZERO
IF( UPPER ) THEN
*
* A is upper triangular.
*
DO J = 2, N
TMAX = MAX( DLANGE( 'M', J-1, 1, A( 1, J ), 1, SUMJ ),
$ TMAX )
END DO
ELSE
*
* A is lower triangular.
*
DO J = 1, N - 1
TMAX = MAX( DLANGE( 'M', N-J, 1, A( J+1, J ), 1,
$ SUMJ ), TMAX )
END DO
END IF
*
IF( TMAX.LE.DLAMCH('Overflow') ) THEN
TSCAL = ONE / ( SMLNUM*TMAX )
DO J = 1, N
IF( CNORM( J ).LE.DLAMCH('Overflow') ) THEN
CNORM( J ) = CNORM( J )*TSCAL
ELSE
* Recompute the 1-norm without introducing Infinity
* in the summation
CNORM( J ) = ZERO
IF( UPPER ) THEN
DO I = 1, J - 1
CNORM( J ) = CNORM( J ) +
$ TSCAL * ABS( A( I, J ) )
END DO
ELSE
DO I = J + 1, N
CNORM( J ) = CNORM( J ) +
$ TSCAL * ABS( A( I, J ) )
END DO
END IF
END IF
END DO
ELSE
* At least one entry of A is not a valid floating-point entry.
* Rely on TRSV to propagate Inf and NaN.
CALL DTRSV( UPLO, TRANS, DIAG, N, A, LDA, X, 1 )
RETURN
END IF
END IF
END IF END IF
* *
* Compute a bound on the computed solution vector to see if the * Compute a bound on the computed solution vector to see if the


+ 1
- 1
lapack-netlib/SRC/slatbs.f View File

@@ -310,6 +310,7 @@
* *
* Quick return if possible * Quick return if possible
* *
SCALE = ONE
IF( N.EQ.0 ) IF( N.EQ.0 )
$ RETURN $ RETURN
* *
@@ -317,7 +318,6 @@
* *
SMLNUM = SLAMCH( 'Safe minimum' ) / SLAMCH( 'Precision' ) SMLNUM = SLAMCH( 'Safe minimum' ) / SLAMCH( 'Precision' )
BIGNUM = ONE / SMLNUM BIGNUM = ONE / SMLNUM
SCALE = ONE
* *
IF( LSAME( NORMIN, 'N' ) ) THEN IF( LSAME( NORMIN, 'N' ) ) THEN
* *


+ 64
- 5
lapack-netlib/SRC/slatrs.f View File

@@ -264,8 +264,8 @@
* .. External Functions .. * .. External Functions ..
LOGICAL LSAME LOGICAL LSAME
INTEGER ISAMAX INTEGER ISAMAX
REAL SASUM, SDOT, SLAMCH
EXTERNAL LSAME, ISAMAX, SASUM, SDOT, SLAMCH
REAL SASUM, SDOT, SLAMCH, SLANGE
EXTERNAL LSAME, ISAMAX, SASUM, SDOT, SLAMCH, SLANGE
* .. * ..
* .. External Subroutines .. * .. External Subroutines ..
EXTERNAL SAXPY, SSCAL, STRSV, XERBLA EXTERNAL SAXPY, SSCAL, STRSV, XERBLA
@@ -304,6 +304,7 @@
* *
* Quick return if possible * Quick return if possible
* *
SCALE = ONE
IF( N.EQ.0 ) IF( N.EQ.0 )
$ RETURN $ RETURN
* *
@@ -311,7 +312,6 @@
* *
SMLNUM = SLAMCH( 'Safe minimum' ) / SLAMCH( 'Precision' ) SMLNUM = SLAMCH( 'Safe minimum' ) / SLAMCH( 'Precision' )
BIGNUM = ONE / SMLNUM BIGNUM = ONE / SMLNUM
SCALE = ONE
* *
IF( LSAME( NORMIN, 'N' ) ) THEN IF( LSAME( NORMIN, 'N' ) ) THEN
* *
@@ -343,8 +343,67 @@
IF( TMAX.LE.BIGNUM ) THEN IF( TMAX.LE.BIGNUM ) THEN
TSCAL = ONE TSCAL = ONE
ELSE ELSE
TSCAL = ONE / ( SMLNUM*TMAX )
CALL SSCAL( N, TSCAL, CNORM, 1 )
*
* Avoid NaN generation if entries in CNORM exceed the
* overflow threshold
*
IF ( TMAX.LE.SLAMCH('Overflow') ) THEN
* Case 1: All entries in CNORM are valid floating-point numbers
TSCAL = ONE / ( SMLNUM*TMAX )
CALL SSCAL( N, TSCAL, CNORM, 1 )
ELSE
* Case 2: At least one column norm of A cannot be represented
* as floating-point number. Find the offdiagonal entry A( I, J )
* with the largest absolute value. If this entry is not +/- Infinity,
* use this value as TSCAL.
TMAX = ZERO
IF( UPPER ) THEN
*
* A is upper triangular.
*
DO J = 2, N
TMAX = MAX( SLANGE( 'M', J-1, 1, A( 1, J ), 1, SUMJ ),
$ TMAX )
END DO
ELSE
*
* A is lower triangular.
*
DO J = 1, N - 1
TMAX = MAX( SLANGE( 'M', N-J, 1, A( J+1, J ), 1,
$ SUMJ ), TMAX )
END DO
END IF
*
IF( TMAX.LE.SLAMCH('Overflow') ) THEN
TSCAL = ONE / ( SMLNUM*TMAX )
DO J = 1, N
IF( CNORM( J ).LE.SLAMCH('Overflow') ) THEN
CNORM( J ) = CNORM( J )*TSCAL
ELSE
* Recompute the 1-norm without introducing Infinity
* in the summation
CNORM( J ) = ZERO
IF( UPPER ) THEN
DO I = 1, J - 1
CNORM( J ) = CNORM( J ) +
$ TSCAL * ABS( A( I, J ) )
END DO
ELSE
DO I = J + 1, N
CNORM( J ) = CNORM( J ) +
$ TSCAL * ABS( A( I, J ) )
END DO
END IF
END IF
END DO
ELSE
* At least one entry of A is not a valid floating-point entry.
* Rely on TRSV to propagate Inf and NaN.
CALL STRSV( UPLO, TRANS, DIAG, N, A, LDA, X, 1 )
RETURN
END IF
END IF
END IF END IF
* *
* Compute a bound on the computed solution vector to see if the * Compute a bound on the computed solution vector to see if the


+ 3
- 6
lapack-netlib/SRC/zlatbs.f View File

@@ -278,7 +278,7 @@
$ ZDOTU, ZLADIV $ ZDOTU, ZLADIV
* .. * ..
* .. External Subroutines .. * .. External Subroutines ..
EXTERNAL DSCAL, XERBLA, ZAXPY, ZDSCAL, ZTBSV, DLABAD
EXTERNAL DSCAL, XERBLA, ZAXPY, ZDSCAL, ZTBSV
* .. * ..
* .. Intrinsic Functions .. * .. Intrinsic Functions ..
INTRINSIC ABS, DBLE, DCMPLX, DCONJG, DIMAG, MAX, MIN INTRINSIC ABS, DBLE, DCMPLX, DCONJG, DIMAG, MAX, MIN
@@ -324,17 +324,14 @@
* *
* Quick return if possible * Quick return if possible
* *
SCALE = ONE
IF( N.EQ.0 ) IF( N.EQ.0 )
$ RETURN $ RETURN
* *
* Determine machine dependent parameters to control overflow. * Determine machine dependent parameters to control overflow.
* *
SMLNUM = DLAMCH( 'Safe minimum' )
BIGNUM = ONE / SMLNUM
CALL DLABAD( SMLNUM, BIGNUM )
SMLNUM = SMLNUM / DLAMCH( 'Precision' )
SMLNUM = DLAMCH( 'Safe minimum' ) / DLAMCH( 'Precision' )
BIGNUM = ONE / SMLNUM BIGNUM = ONE / SMLNUM
SCALE = ONE
* *
IF( LSAME( NORMIN, 'N' ) ) THEN IF( LSAME( NORMIN, 'N' ) ) THEN
* *


+ 71
- 8
lapack-netlib/SRC/zlatrs.f View File

@@ -274,7 +274,7 @@
$ ZDOTU, ZLADIV $ ZDOTU, ZLADIV
* .. * ..
* .. External Subroutines .. * .. External Subroutines ..
EXTERNAL DSCAL, XERBLA, ZAXPY, ZDSCAL, ZTRSV, DLABAD
EXTERNAL DSCAL, XERBLA, ZAXPY, ZDSCAL, ZTRSV
* .. * ..
* .. Intrinsic Functions .. * .. Intrinsic Functions ..
INTRINSIC ABS, DBLE, DCMPLX, DCONJG, DIMAG, MAX, MIN INTRINSIC ABS, DBLE, DCMPLX, DCONJG, DIMAG, MAX, MIN
@@ -318,17 +318,14 @@
* *
* Quick return if possible * Quick return if possible
* *
SCALE = ONE
IF( N.EQ.0 ) IF( N.EQ.0 )
$ RETURN $ RETURN
* *
* Determine machine dependent parameters to control overflow. * Determine machine dependent parameters to control overflow.
* *
SMLNUM = DLAMCH( 'Safe minimum' )
BIGNUM = ONE / SMLNUM
CALL DLABAD( SMLNUM, BIGNUM )
SMLNUM = SMLNUM / DLAMCH( 'Precision' )
SMLNUM = DLAMCH( 'Safe minimum' ) / DLAMCH( 'Precision' )
BIGNUM = ONE / SMLNUM BIGNUM = ONE / SMLNUM
SCALE = ONE
* *
IF( LSAME( NORMIN, 'N' ) ) THEN IF( LSAME( NORMIN, 'N' ) ) THEN
* *
@@ -360,8 +357,74 @@
IF( TMAX.LE.BIGNUM*HALF ) THEN IF( TMAX.LE.BIGNUM*HALF ) THEN
TSCAL = ONE TSCAL = ONE
ELSE ELSE
TSCAL = HALF / ( SMLNUM*TMAX )
CALL DSCAL( N, TSCAL, CNORM, 1 )
*
* Avoid NaN generation if entries in CNORM exceed the
* overflow threshold
*
IF ( TMAX.LE.DLAMCH('Overflow') ) THEN
* Case 1: All entries in CNORM are valid floating-point numbers
TSCAL = HALF / ( SMLNUM*TMAX )
CALL DSCAL( N, TSCAL, CNORM, 1 )
ELSE
* Case 2: At least one column norm of A cannot be
* represented as a floating-point number. Find the
* maximum offdiagonal absolute value
* max( |Re(A(I,J))|, |Im(A(I,J)| ). If this entry is
* not +/- Infinity, use this value as TSCAL.
TMAX = ZERO
IF( UPPER ) THEN
*
* A is upper triangular.
*
DO J = 2, N
DO I = 1, J - 1
TMAX = MAX( TMAX, ABS( DBLE( A( I, J ) ) ),
$ ABS( DIMAG(A ( I, J ) ) ) )
END DO
END DO
ELSE
*
* A is lower triangular.
*
DO J = 1, N - 1
DO I = J + 1, N
TMAX = MAX( TMAX, ABS( DBLE( A( I, J ) ) ),
$ ABS( DIMAG(A ( I, J ) ) ) )
END DO
END DO
END IF
*
IF( TMAX.LE.DLAMCH('Overflow') ) THEN
TSCAL = ONE / ( SMLNUM*TMAX )
DO J = 1, N
IF( CNORM( J ).LE.DLAMCH('Overflow') ) THEN
CNORM( J ) = CNORM( J )*TSCAL
ELSE
* Recompute the 1-norm of each column without
* introducing Infinity in the summation.
TSCAL = TWO * TSCAL
CNORM( J ) = ZERO
IF( UPPER ) THEN
DO I = 1, J - 1
CNORM( J ) = CNORM( J ) +
$ TSCAL * CABS2( A( I, J ) )
END DO
ELSE
DO I = J + 1, N
CNORM( J ) = CNORM( J ) +
$ TSCAL * CABS2( A( I, J ) )
END DO
END IF
TSCAL = TSCAL * HALF
END IF
END DO
ELSE
* At least one entry of A is not a valid floating-point
* entry. Rely on TRSV to propagate Inf and NaN.
CALL ZTRSV( UPLO, TRANS, DIAG, N, A, LDA, X, 1 )
RETURN
END IF
END IF
END IF END IF
* *
* Compute a bound on the computed solution vector to see if the * Compute a bound on the computed solution vector to see if the


Write Preview
Loading…
Cancel
Save