1 INTEGER FUNCTION IEEECK( ISPEC, ZERO, ONE ) 2* 3* -- LAPACK auxiliary routine (version 3.0) -- 4* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., 5* Courant Institute, Argonne National Lab, and Rice University 6* June 30, 1998 7* 8* .. Scalar Arguments .. 9 INTEGER ISPEC 10 REAL ONE, ZERO 11* .. 12* 13* Purpose 14* ======= 15* 16* IEEECK is called from the ILAENV to verify that Infinity and 17* possibly NaN arithmetic is safe (i.e. will not trap). 18* 19* Arguments 20* ========= 21* 22* ISPEC (input) INTEGER 23* Specifies whether to test just for inifinity arithmetic 24* or whether to test for infinity and NaN arithmetic. 25* = 0: Verify infinity arithmetic only. 26* = 1: Verify infinity and NaN arithmetic. 27* 28* ZERO (input) REAL 29* Must contain the value 0.0 30* This is passed to prevent the compiler from optimizing 31* away this code. 32* 33* ONE (input) REAL 34* Must contain the value 1.0 35* This is passed to prevent the compiler from optimizing 36* away this code. 37* 38* RETURN VALUE: INTEGER 39* = 0: Arithmetic failed to produce the correct answers 40* = 1: Arithmetic produced the correct answers 41* 42* .. Local Scalars .. 43 REAL NAN1, NAN2, NAN3, NAN4, NAN5, NAN6, NEGINF, 44 $ NEGZRO, NEWZRO, POSINF 45* .. 46* .. Executable Statements .. 47 IEEECK = 1 48* 49 POSINF = ONE / ZERO 50 IF( POSINF.LE.ONE ) THEN 51 IEEECK = 0 52 RETURN 53 END IF 54* 55 NEGINF = -ONE / ZERO 56 IF( NEGINF.GE.ZERO ) THEN 57 IEEECK = 0 58 RETURN 59 END IF 60* 61 NEGZRO = ONE / ( NEGINF+ONE ) 62 IF( NEGZRO.NE.ZERO ) THEN 63 IEEECK = 0 64 RETURN 65 END IF 66* 67 NEGINF = ONE / NEGZRO 68 IF( NEGINF.GE.ZERO ) THEN 69 IEEECK = 0 70 RETURN 71 END IF 72* 73 NEWZRO = NEGZRO + ZERO 74 IF( NEWZRO.NE.ZERO ) THEN 75 IEEECK = 0 76 RETURN 77 END IF 78* 79 POSINF = ONE / NEWZRO 80 IF( POSINF.LE.ONE ) THEN 81 IEEECK = 0 82 RETURN 83 END IF 84* 85 NEGINF = NEGINF*POSINF 86 IF( NEGINF.GE.ZERO ) THEN 87 IEEECK = 0 88 RETURN 89 END IF 90* 91 POSINF = POSINF*POSINF 92 IF( POSINF.LE.ONE ) THEN 93 IEEECK = 0 94 RETURN 95 END IF 96* 97* 98* 99* 100* Return if we were only asked to check infinity arithmetic 101* 102 IF( ISPEC.EQ.0 ) 103 $ RETURN 104* 105 NAN1 = POSINF + NEGINF 106* 107 NAN2 = POSINF / NEGINF 108* 109 NAN3 = POSINF / POSINF 110* 111 NAN4 = POSINF*ZERO 112* 113 NAN5 = NEGINF*NEGZRO 114* 115 NAN6 = NAN5*0.0 116* 117 IF( NAN1.EQ.NAN1 ) THEN 118 IEEECK = 0 119 RETURN 120 END IF 121* 122 IF( NAN2.EQ.NAN2 ) THEN 123 IEEECK = 0 124 RETURN 125 END IF 126* 127 IF( NAN3.EQ.NAN3 ) THEN 128 IEEECK = 0 129 RETURN 130 END IF 131* 132 IF( NAN4.EQ.NAN4 ) THEN 133 IEEECK = 0 134 RETURN 135 END IF 136* 137 IF( NAN5.EQ.NAN5 ) THEN 138 IEEECK = 0 139 RETURN 140 END IF 141* 142 IF( NAN6.EQ.NAN6 ) THEN 143 IEEECK = 0 144 RETURN 145 END IF 146* 147 RETURN 148 END 149