![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to ieeeck.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / lapack / lapack|
Return to ieeeck.f CVS log | Up to [local] / rpl / lapack / lapack |
1.1 bertrand 1: INTEGER FUNCTION IEEECK( ISPEC, ZERO, ONE )
2: *
1.9 ! bertrand 3: * -- LAPACK auxiliary routine (version 3.3.1) --
1.1 bertrand 4: * -- LAPACK is a software package provided by Univ. of Tennessee, --
5: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
1.9 ! bertrand 6: * -- April 2011 --
1.1 bertrand 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: *
1.9 ! bertrand 42: * =====================================================================
! 43: *
1.1 bertrand 44: * .. Local Scalars ..
45: REAL NAN1, NAN2, NAN3, NAN4, NAN5, NAN6, NEGINF,
46: $ NEGZRO, NEWZRO, POSINF
47: * ..
48: * .. Executable Statements ..
49: IEEECK = 1
50: *
51: POSINF = ONE / ZERO
52: IF( POSINF.LE.ONE ) THEN
53: IEEECK = 0
54: RETURN
55: END IF
56: *
57: NEGINF = -ONE / ZERO
58: IF( NEGINF.GE.ZERO ) THEN
59: IEEECK = 0
60: RETURN
61: END IF
62: *
63: NEGZRO = ONE / ( NEGINF+ONE )
64: IF( NEGZRO.NE.ZERO ) THEN
65: IEEECK = 0
66: RETURN
67: END IF
68: *
69: NEGINF = ONE / NEGZRO
70: IF( NEGINF.GE.ZERO ) THEN
71: IEEECK = 0
72: RETURN
73: END IF
74: *
75: NEWZRO = NEGZRO + ZERO
76: IF( NEWZRO.NE.ZERO ) THEN
77: IEEECK = 0
78: RETURN
79: END IF
80: *
81: POSINF = ONE / NEWZRO
82: IF( POSINF.LE.ONE ) THEN
83: IEEECK = 0
84: RETURN
85: END IF
86: *
87: NEGINF = NEGINF*POSINF
88: IF( NEGINF.GE.ZERO ) THEN
89: IEEECK = 0
90: RETURN
91: END IF
92: *
93: POSINF = POSINF*POSINF
94: IF( POSINF.LE.ONE ) THEN
95: IEEECK = 0
96: RETURN
97: END IF
98: *
99: *
100: *
101: *
102: * Return if we were only asked to check infinity arithmetic
103: *
104: IF( ISPEC.EQ.0 )
105: $ RETURN
106: *
107: NAN1 = POSINF + NEGINF
108: *
109: NAN2 = POSINF / NEGINF
110: *
111: NAN3 = POSINF / POSINF
112: *
113: NAN4 = POSINF*ZERO
114: *
115: NAN5 = NEGINF*NEGZRO
116: *
1.5 bertrand 117: NAN6 = NAN5*ZERO
1.1 bertrand 118: *
119: IF( NAN1.EQ.NAN1 ) THEN
120: IEEECK = 0
121: RETURN
122: END IF
123: *
124: IF( NAN2.EQ.NAN2 ) THEN
125: IEEECK = 0
126: RETURN
127: END IF
128: *
129: IF( NAN3.EQ.NAN3 ) THEN
130: IEEECK = 0
131: RETURN
132: END IF
133: *
134: IF( NAN4.EQ.NAN4 ) THEN
135: IEEECK = 0
136: RETURN
137: END IF
138: *
139: IF( NAN5.EQ.NAN5 ) THEN
140: IEEECK = 0
141: RETURN
142: END IF
143: *
144: IF( NAN6.EQ.NAN6 ) THEN
145: IEEECK = 0
146: RETURN
147: END IF
148: *
149: RETURN
150: END