diff options
| author | james <james@8a072113-8704-0410-8d35-dd094bca7971> | 2012-01-20 15:12:13 +0000 |
|---|---|---|
| committer | james <james@8a072113-8704-0410-8d35-dd094bca7971> | 2012-01-20 15:12:13 +0000 |
| commit | 5906b884236c59c3dc2c79dd6c96c6cf503ad4e8 (patch) | |
| tree | 91e531a51e849c643a7d2d5f4d605bfde0b2b7cc /BLAS | |
| parent | a880822a50ed17ebe82110f388b883f1bd8817f8 (diff) | |
| download | lapack-5906b884236c59c3dc2c79dd6c96c6cf503ad4e8.tar.gz lapack-5906b884236c59c3dc2c79dd6c96c6cf503ad4e8.tar.bz2 lapack-5906b884236c59c3dc2c79dd6c96c6cf503ad4e8.zip | |
Fixed problem with optimizer breaking error checking, now using F90 EPSILON intrinsic.
Thanks to Harald Anlauf for providing the solution.
Diffstat (limited to 'BLAS')
| -rw-r--r-- | BLAS/TESTING/cblat1.f | 5 | ||||
| -rw-r--r-- | BLAS/TESTING/dblat1.f | 10 | ||||
| -rw-r--r-- | BLAS/TESTING/sblat1.f | 5 | ||||
| -rw-r--r-- | BLAS/TESTING/zblat1.f | 5 |
4 files changed, 15 insertions, 10 deletions
diff --git a/BLAS/TESTING/cblat1.f b/BLAS/TESTING/cblat1.f index 59632018..88db1e68 100644 --- a/BLAS/TESTING/cblat1.f +++ b/BLAS/TESTING/cblat1.f @@ -571,7 +571,8 @@ * * .. Parameters .. INTEGER NOUT - PARAMETER (NOUT=6) + REAL ZERO + PARAMETER (NOUT=6, ZERO=0.0E0) * .. Scalar Arguments .. REAL SFAC INTEGER LEN @@ -594,7 +595,7 @@ * DO 40 I = 1, LEN SD = SCOMP(I) - STRUE(I) - IF (SDIFF(ABS(SSIZE(I))+ABS(SFAC*SD),ABS(SSIZE(I))).EQ.0.0E0) + IF (ABS(SFAC*SD) .LE. ABS(SSIZE(I))*EPSILON(ZERO)) + GO TO 40 * * HERE SCOMP(I) IS NOT CLOSE TO STRUE(I). diff --git a/BLAS/TESTING/dblat1.f b/BLAS/TESTING/dblat1.f index 23944c6a..0294d91e 100644 --- a/BLAS/TESTING/dblat1.f +++ b/BLAS/TESTING/dblat1.f @@ -894,7 +894,8 @@ * * .. Parameters .. INTEGER NOUT - PARAMETER (NOUT=6) + DOUBLE PRECISION ZERO + PARAMETER (NOUT=6, ZERO=0.0D0) * .. Scalar Arguments .. DOUBLE PRECISION SFAC INTEGER LEN @@ -917,7 +918,7 @@ * DO 40 I = 1, LEN SD = SCOMP(I) - STRUE(I) - IF (SDIFF(ABS(SSIZE(I))+ABS(SFAC*SD),ABS(SSIZE(I))).EQ.0.0D0) + IF (ABS(SFAC*SD) .LE. ABS(SSIZE(I))*EPSILON(ZERO)) + GO TO 40 * * HERE SCOMP(I) IS NOT CLOSE TO STRUE(I). @@ -949,7 +950,8 @@ * * .. Parameters .. INTEGER NOUT - PARAMETER (NOUT=6) + REAL ZERO + PARAMETER (NOUT=6, ZERO=0.0E0) * .. Scalar Arguments .. REAL SFAC, SCOMP, SSIZE, STRUE * .. Scalars in Common .. @@ -964,7 +966,7 @@ * .. Executable Statements .. * SD = SCOMP - STRUE - IF ((ABS(SSIZE)+ABS(SFAC*SD)-ABS(SSIZE)).EQ.0.0E0) + IF (ABS(SFAC*SD) .LE. ABS(SSIZE) * EPSILON(ZERO)) + GO TO 40 * * HERE SCOMP(I) IS NOT CLOSE TO STRUE(I). diff --git a/BLAS/TESTING/sblat1.f b/BLAS/TESTING/sblat1.f index bf336d6b..b78e10af 100644 --- a/BLAS/TESTING/sblat1.f +++ b/BLAS/TESTING/sblat1.f @@ -898,7 +898,8 @@ * * .. Parameters .. INTEGER NOUT - PARAMETER (NOUT=6) + REAL ZERO + PARAMETER (NOUT=6, ZERO=0.0E0) * .. Scalar Arguments .. REAL SFAC INTEGER LEN @@ -921,7 +922,7 @@ * DO 40 I = 1, LEN SD = SCOMP(I) - STRUE(I) - IF (SDIFF(ABS(SSIZE(I))+ABS(SFAC*SD),ABS(SSIZE(I))).EQ.0.0E0) + IF (ABS(SFAC*SD) .LE. ABS(SSIZE(I))*EPSILON(ZERO)) + GO TO 40 * * HERE SCOMP(I) IS NOT CLOSE TO STRUE(I). diff --git a/BLAS/TESTING/zblat1.f b/BLAS/TESTING/zblat1.f index 3e7f2d4a..36419cae 100644 --- a/BLAS/TESTING/zblat1.f +++ b/BLAS/TESTING/zblat1.f @@ -571,7 +571,8 @@ * * .. Parameters .. INTEGER NOUT - PARAMETER (NOUT=6) + DOUBLE PRECISION ZERO + PARAMETER (NOUT=6, ZERO=0.0D0) * .. Scalar Arguments .. DOUBLE PRECISION SFAC INTEGER LEN @@ -594,7 +595,7 @@ * DO 40 I = 1, LEN SD = SCOMP(I) - STRUE(I) - IF (SDIFF(ABS(SSIZE(I))+ABS(SFAC*SD),ABS(SSIZE(I))).EQ.0.0D0) + IF (ABS(SFAC*SD) .LE. ABS(SSIZE(I))*EPSILON(ZERO)) + GO TO 40 * * HERE SCOMP(I) IS NOT CLOSE TO STRUE(I). |