diff options
| author | james <james@8a072113-8704-0410-8d35-dd094bca7971> | 2012-07-17 13:15:40 +0000 |
|---|---|---|
| committer | james <james@8a072113-8704-0410-8d35-dd094bca7971> | 2012-07-17 13:15:40 +0000 |
| commit | 2a180a73cd84e5bfdd306d649e1713e144a6f132 (patch) | |
| tree | 91ba6060429347a30ee625f0ebade4b018b91cb7 | |
| parent | b0ccd072d7381538a5947bc93908abeabaaf83d8 (diff) | |
| download | lapack-2a180a73cd84e5bfdd306d649e1713e144a6f132.tar.gz lapack-2a180a73cd84e5bfdd306d649e1713e144a6f132.tar.bz2 lapack-2a180a73cd84e5bfdd306d649e1713e144a6f132.zip | |
added NaN check to prevent NaN's from being skipped in accumulation
| -rw-r--r-- | SRC/classq.f | 14 | ||||
| -rw-r--r-- | SRC/dlassq.f | 8 | ||||
| -rw-r--r-- | SRC/slassq.f | 8 | ||||
| -rw-r--r-- | SRC/zlassq.f | 12 |
4 files changed, 29 insertions, 13 deletions
diff --git a/SRC/classq.f b/SRC/classq.f index af027f9d..2b8a5033 100644 --- a/SRC/classq.f +++ b/SRC/classq.f @@ -129,6 +129,10 @@ INTEGER IX REAL TEMP1 * .. +* .. External Functions .. + LOGICAL SISNAN + EXTERNAL SISNAN +* .. * .. Intrinsic Functions .. INTRINSIC ABS, AIMAG, REAL * .. @@ -136,8 +140,8 @@ * IF( N.GT.0 ) THEN DO 10 IX = 1, 1 + ( N-1 )*INCX, INCX - IF( REAL( X( IX ) ).NE.ZERO ) THEN - TEMP1 = ABS( REAL( X( IX ) ) ) + TEMP1 = ABS( REAL( X( IX ) ) ) + IF( TEMP1.GT.ZERO.OR.SISNAN( TEMP1 ) ) THEN IF( SCALE.LT.TEMP1 ) THEN SUMSQ = 1 + SUMSQ*( SCALE / TEMP1 )**2 SCALE = TEMP1 @@ -145,9 +149,9 @@ SUMSQ = SUMSQ + ( TEMP1 / SCALE )**2 END IF END IF - IF( AIMAG( X( IX ) ).NE.ZERO ) THEN - TEMP1 = ABS( AIMAG( X( IX ) ) ) - IF( SCALE.LT.TEMP1 ) THEN + TEMP1 = ABS( AIMAG( X( IX ) ) ) + IF( TEMP1.GT.ZERO.OR.SISNAN( TEMP1 ) ) THEN + IF( SCALE.LT.TEMP1 .OR. SISNAN( TEMP1 ) ) THEN SUMSQ = 1 + SUMSQ*( SCALE / TEMP1 )**2 SCALE = TEMP1 ELSE diff --git a/SRC/dlassq.f b/SRC/dlassq.f index db5b5946..ee039b93 100644 --- a/SRC/dlassq.f +++ b/SRC/dlassq.f @@ -126,6 +126,10 @@ INTEGER IX DOUBLE PRECISION ABSXI * .. +* .. External Functions .. + LOGICAL DISNAN + EXTERNAL DISNAN +* .. * .. Intrinsic Functions .. INTRINSIC ABS * .. @@ -133,8 +137,8 @@ * IF( N.GT.0 ) THEN DO 10 IX = 1, 1 + ( N-1 )*INCX, INCX - IF( X( IX ).NE.ZERO ) THEN - ABSXI = ABS( X( IX ) ) + ABSXI = ABS( X( IX ) ) + IF( ABSXI.GT.ZERO.OR.DISNAN( ABSXI ) ) THEN IF( SCALE.LT.ABSXI ) THEN SUMSQ = 1 + SUMSQ*( SCALE / ABSXI )**2 SCALE = ABSXI diff --git a/SRC/slassq.f b/SRC/slassq.f index 8e873808..f8af9049 100644 --- a/SRC/slassq.f +++ b/SRC/slassq.f @@ -126,6 +126,10 @@ INTEGER IX REAL ABSXI * .. +* .. External Functions .. + LOGICAL SISNAN + EXTERNAL SISNAN +* .. * .. Intrinsic Functions .. INTRINSIC ABS * .. @@ -133,8 +137,8 @@ * IF( N.GT.0 ) THEN DO 10 IX = 1, 1 + ( N-1 )*INCX, INCX - IF( X( IX ).NE.ZERO ) THEN - ABSXI = ABS( X( IX ) ) + ABSXI = ABS( X( IX ) ) + IF( ABSXI.GT.ZERO.OR.SISNAN( ABSXI ) ) THEN IF( SCALE.LT.ABSXI ) THEN SUMSQ = 1 + SUMSQ*( SCALE / ABSXI )**2 SCALE = ABSXI diff --git a/SRC/zlassq.f b/SRC/zlassq.f index d69b5ba3..59ad6966 100644 --- a/SRC/zlassq.f +++ b/SRC/zlassq.f @@ -129,6 +129,10 @@ INTEGER IX DOUBLE PRECISION TEMP1 * .. +* .. External Functions .. + LOGICAL DISNAN + EXTERNAL DISNAN +* .. * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, DIMAG * .. @@ -136,8 +140,8 @@ * IF( N.GT.0 ) THEN DO 10 IX = 1, 1 + ( N-1 )*INCX, INCX - IF( DBLE( X( IX ) ).NE.ZERO ) THEN - TEMP1 = ABS( DBLE( X( IX ) ) ) + TEMP1 = ABS( DBLE( X( IX ) ) ) + IF( TEMP1.GT.ZERO.OR.DISNAN( TEMP1 ) ) THEN IF( SCALE.LT.TEMP1 ) THEN SUMSQ = 1 + SUMSQ*( SCALE / TEMP1 )**2 SCALE = TEMP1 @@ -145,8 +149,8 @@ SUMSQ = SUMSQ + ( TEMP1 / SCALE )**2 END IF END IF - IF( DIMAG( X( IX ) ).NE.ZERO ) THEN - TEMP1 = ABS( DIMAG( X( IX ) ) ) + TEMP1 = ABS( DIMAG( X( IX ) ) ) + IF( TEMP1.GT.ZERO.OR.DISNAN( TEMP1 ) ) THEN IF( SCALE.LT.TEMP1 ) THEN SUMSQ = 1 + SUMSQ*( SCALE / TEMP1 )**2 SCALE = TEMP1 |