![[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.5 bertrand 3: * -- LAPACK auxiliary routine (version 3.2.2) --
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.5 bertrand 6: * June 2010
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: *
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: *
1.5 bertrand 115: NAN6 = NAN5*ZERO
1.1 bertrand 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