001:       INTEGER          FUNCTION IEEECK( ISPEC, ZERO, ONE )
002: *
003: *  -- LAPACK auxiliary routine (version 3.2) --
004: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
005: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
006: *     November 2006
007: *
008: *     .. Scalar Arguments ..
009:       INTEGER            ISPEC
010:       REAL               ONE, ZERO
011: *     ..
012: *
013: *  Purpose
014: *  =======
015: *
016: *  IEEECK is called from the ILAENV to verify that Infinity and
017: *  possibly NaN arithmetic is safe (i.e. will not trap).
018: *
019: *  Arguments
020: *  =========
021: *
022: *  ISPEC   (input) INTEGER
023: *          Specifies whether to test just for inifinity arithmetic
024: *          or whether to test for infinity and NaN arithmetic.
025: *          = 0: Verify infinity arithmetic only.
026: *          = 1: Verify infinity and NaN arithmetic.
027: *
028: *  ZERO    (input) REAL
029: *          Must contain the value 0.0
030: *          This is passed to prevent the compiler from optimizing
031: *          away this code.
032: *
033: *  ONE     (input) REAL
034: *          Must contain the value 1.0
035: *          This is passed to prevent the compiler from optimizing
036: *          away this code.
037: *
038: *  RETURN VALUE:  INTEGER
039: *          = 0:  Arithmetic failed to produce the correct answers
040: *          = 1:  Arithmetic produced the correct answers
041: *
042: *     .. Local Scalars ..
043:       REAL               NAN1, NAN2, NAN3, NAN4, NAN5, NAN6, NEGINF,
044:      $                   NEGZRO, NEWZRO, POSINF
045: *     ..
046: *     .. Executable Statements ..
047:       IEEECK = 1
048: *
049:       POSINF = ONE / ZERO
050:       IF( POSINF.LE.ONE ) THEN
051:          IEEECK = 0
052:          RETURN
053:       END IF
054: *
055:       NEGINF = -ONE / ZERO
056:       IF( NEGINF.GE.ZERO ) THEN
057:          IEEECK = 0
058:          RETURN
059:       END IF
060: *
061:       NEGZRO = ONE / ( NEGINF+ONE )
062:       IF( NEGZRO.NE.ZERO ) THEN
063:          IEEECK = 0
064:          RETURN
065:       END IF
066: *
067:       NEGINF = ONE / NEGZRO
068:       IF( NEGINF.GE.ZERO ) THEN
069:          IEEECK = 0
070:          RETURN
071:       END IF
072: *
073:       NEWZRO = NEGZRO + ZERO
074:       IF( NEWZRO.NE.ZERO ) THEN
075:          IEEECK = 0
076:          RETURN
077:       END IF
078: *
079:       POSINF = ONE / NEWZRO
080:       IF( POSINF.LE.ONE ) THEN
081:          IEEECK = 0
082:          RETURN
083:       END IF
084: *
085:       NEGINF = NEGINF*POSINF
086:       IF( NEGINF.GE.ZERO ) THEN
087:          IEEECK = 0
088:          RETURN
089:       END IF
090: *
091:       POSINF = POSINF*POSINF
092:       IF( POSINF.LE.ONE ) THEN
093:          IEEECK = 0
094:          RETURN
095:       END IF
096: *
097: *
098: *
099: *
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: