LAPACK  3.10.0
LAPACK: Linear Algebra PACKage
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 *> \ingroup OTHERauxiliary
79 *
80 * =====================================================================
81  INTEGER FUNCTION ieeeck( ISPEC, ZERO, ONE )
82 *
83 * -- LAPACK auxiliary routine --
84 * -- LAPACK is a software package provided by Univ. of Tennessee, --
85 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
86 *
87 * .. Scalar Arguments ..
88  INTEGER ispec
89  REAL one, zero
90 * ..
91 *
92 * =====================================================================
93 *
94 * .. Local Scalars ..
95  REAL nan1, nan2, nan3, nan4, nan5, nan6, neginf,
96  $ negzro, newzro, posinf
97 * ..
98 * .. Executable Statements ..
99  ieeeck = 1
100 *
101  posinf = one / zero
102  IF( posinf.LE.one ) THEN
103  ieeeck = 0
104  RETURN
105  END IF
106 *
107  neginf = -one / zero
108  IF( neginf.GE.zero ) THEN
109  ieeeck = 0
110  RETURN
111  END IF
112 *
113  negzro = one / ( neginf+one )
114  IF( negzro.NE.zero ) THEN
115  ieeeck = 0
116  RETURN
117  END IF
118 *
119  neginf = one / negzro
120  IF( neginf.GE.zero ) THEN
121  ieeeck = 0
122  RETURN
123  END IF
124 *
125  newzro = negzro + zero
126  IF( newzro.NE.zero ) THEN
127  ieeeck = 0
128  RETURN
129  END IF
130 *
131  posinf = one / newzro
132  IF( posinf.LE.one ) THEN
133  ieeeck = 0
134  RETURN
135  END IF
136 *
137  neginf = neginf*posinf
138  IF( neginf.GE.zero ) THEN
139  ieeeck = 0
140  RETURN
141  END IF
142 *
143  posinf = posinf*posinf
144  IF( posinf.LE.one ) THEN
145  ieeeck = 0
146  RETURN
147  END IF
148 *
149 *
150 *
151 *
152 * Return if we were only asked to check infinity arithmetic
153 *
154  IF( ispec.EQ.0 )
155  $ RETURN
156 *
157  nan1 = posinf + neginf
158 *
159  nan2 = posinf / neginf
160 *
161  nan3 = posinf / posinf
162 *
163  nan4 = posinf*zero
164 *
165  nan5 = neginf*negzro
166 *
167  nan6 = nan5*zero
168 *
169  IF( nan1.EQ.nan1 ) THEN
170  ieeeck = 0
171  RETURN
172  END IF
173 *
174  IF( nan2.EQ.nan2 ) THEN
175  ieeeck = 0
176  RETURN
177  END IF
178 *
179  IF( nan3.EQ.nan3 ) THEN
180  ieeeck = 0
181  RETURN
182  END IF
183 *
184  IF( nan4.EQ.nan4 ) THEN
185  ieeeck = 0
186  RETURN
187  END IF
188 *
189  IF( nan5.EQ.nan5 ) THEN
190  ieeeck = 0
191  RETURN
192  END IF
193 *
194  IF( nan6.EQ.nan6 ) THEN
195  ieeeck = 0
196  RETURN
197  END IF
198 *
199  RETURN
200  END
integer function ieeeck(ISPEC, ZERO, ONE)
IEEECK
Definition: ieeeck.f:82