KTH framework for Nek5000 toolboxes; testing version  0.0.1
ieeeck.f
Go to the documentation of this file.
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
integer function ieeeck(ISPEC, ZERO, ONE)
Definition: ieeeck.f:2