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