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
ieeeck
integer function ieeeck(ispec, zero, one)
IEEECK
Definition
ieeeck.f:80
SRC
ieeeck.f
Generated on Mon Jan 20 2025 17:18:11 for LAPACK by
1.11.0