LAPACK  3.4.2
LAPACK: Linear Algebra PACKage
 All Files Functions Groups
ieeeck.f
Go to the documentation of this file.
1 *> \brief \b IEEECK
2 *
3 * =========== DOCUMENTATION ===========
4 *
5 * Online html documentation available at
6 * http://www.netlib.org/lapack/explore-html/
7 *
8 *> \htmlonly
9 *> Download IEEECK + dependencies
10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ieeeck.f">
11 *> [TGZ]</a>
12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ieeeck.f">
13 *> [ZIP]</a>
14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ieeeck.f">
15 *> [TXT]</a>
16 *> \endhtmlonly
17 *
18 * Definition:
19 * ===========
20 *
21 * INTEGER FUNCTION IEEECK( ISPEC, ZERO, ONE )
22 *
23 * .. Scalar Arguments ..
24 * INTEGER ISPEC
25 * REAL ONE, ZERO
26 * ..
27 *
28 *
29 *> \par Purpose:
30 * =============
31 *>
32 *> \verbatim
33 *>
34 *> IEEECK is called from the ILAENV to verify that Infinity and
35 *> possibly NaN arithmetic is safe (i.e. will not trap).
36 *> \endverbatim
37 *
38 * Arguments:
39 * ==========
40 *
41 *> \param[in] ISPEC
42 *> \verbatim
43 *> ISPEC is INTEGER
44 *> Specifies whether to test just for inifinity arithmetic
45 *> or whether to test for infinity and NaN arithmetic.
46 *> = 0: Verify infinity arithmetic only.
47 *> = 1: Verify infinity and NaN arithmetic.
48 *> \endverbatim
49 *>
50 *> \param[in] ZERO
51 *> \verbatim
52 *> ZERO is REAL
53 *> Must contain the value 0.0
54 *> This is passed to prevent the compiler from optimizing
55 *> away this code.
56 *> \endverbatim
57 *>
58 *> \param[in] ONE
59 *> \verbatim
60 *> ONE is REAL
61 *> Must contain the value 1.0
62 *> This is passed to prevent the compiler from optimizing
63 *> away this code.
64 *>
65 *> RETURN VALUE: INTEGER
66 *> = 0: Arithmetic failed to produce the correct answers
67 *> = 1: Arithmetic produced the correct answers
68 *> \endverbatim
69 *
70 * Authors:
71 * ========
72 *
73 *> \author Univ. of Tennessee
74 *> \author Univ. of California Berkeley
75 *> \author Univ. of Colorado Denver
76 *> \author NAG Ltd.
77 *
78 *> \date November 2011
79 *
80 *> \ingroup auxOTHERauxiliary
81 *
82 * =====================================================================
83  INTEGER FUNCTION ieeeck( ISPEC, ZERO, ONE )
84 *
85 * -- LAPACK auxiliary routine (version 3.4.0) --
86 * -- LAPACK is a software package provided by Univ. of Tennessee, --
87 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
88 * November 2011
89 *
90 * .. Scalar Arguments ..
91  INTEGER ispec
92  REAL one, zero
93 * ..
94 *
95 * =====================================================================
96 *
97 * .. Local Scalars ..
98  REAL nan1, nan2, nan3, nan4, nan5, nan6, neginf,
99  $ negzro, newzro, posinf
100 * ..
101 * .. Executable Statements ..
102  ieeeck = 1
103 *
104  posinf = one / zero
105  IF( posinf.LE.one ) THEN
106  ieeeck = 0
107  return
108  END IF
109 *
110  neginf = -one / zero
111  IF( neginf.GE.zero ) THEN
112  ieeeck = 0
113  return
114  END IF
115 *
116  negzro = one / ( neginf+one )
117  IF( negzro.NE.zero ) THEN
118  ieeeck = 0
119  return
120  END IF
121 *
122  neginf = one / negzro
123  IF( neginf.GE.zero ) THEN
124  ieeeck = 0
125  return
126  END IF
127 *
128  newzro = negzro + zero
129  IF( newzro.NE.zero ) THEN
130  ieeeck = 0
131  return
132  END IF
133 *
134  posinf = one / newzro
135  IF( posinf.LE.one ) THEN
136  ieeeck = 0
137  return
138  END IF
139 *
140  neginf = neginf*posinf
141  IF( neginf.GE.zero ) THEN
142  ieeeck = 0
143  return
144  END IF
145 *
146  posinf = posinf*posinf
147  IF( posinf.LE.one ) THEN
148  ieeeck = 0
149  return
150  END IF
151 *
152 *
153 *
154 *
155 * Return if we were only asked to check infinity arithmetic
156 *
157  IF( ispec.EQ.0 )
158  $ return
159 *
160  nan1 = posinf + neginf
161 *
162  nan2 = posinf / neginf
163 *
164  nan3 = posinf / posinf
165 *
166  nan4 = posinf*zero
167 *
168  nan5 = neginf*negzro
169 *
170  nan6 = nan5*zero
171 *
172  IF( nan1.EQ.nan1 ) THEN
173  ieeeck = 0
174  return
175  END IF
176 *
177  IF( nan2.EQ.nan2 ) THEN
178  ieeeck = 0
179  return
180  END IF
181 *
182  IF( nan3.EQ.nan3 ) THEN
183  ieeeck = 0
184  return
185  END IF
186 *
187  IF( nan4.EQ.nan4 ) THEN
188  ieeeck = 0
189  return
190  END IF
191 *
192  IF( nan5.EQ.nan5 ) THEN
193  ieeeck = 0
194  return
195  END IF
196 *
197  IF( nan6.EQ.nan6 ) THEN
198  ieeeck = 0
199  return
200  END IF
201 *
202  return
203  END