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