Annotation of rpl/lapack/lapack/ieeeck.f, revision 1.18
1.10 bertrand 1: *> \brief \b IEEECK
2: *
3: * =========== DOCUMENTATION ===========
4: *
1.16 bertrand 5: * Online html documentation available at
6: * http://www.netlib.org/lapack/explore-html/
1.10 bertrand 7: *
8: *> \htmlonly
1.16 bertrand 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">
1.10 bertrand 15: *> [TXT]</a>
1.16 bertrand 16: *> \endhtmlonly
1.10 bertrand 17: *
18: * Definition:
19: * ===========
20: *
21: * INTEGER FUNCTION IEEECK( ISPEC, ZERO, ONE )
1.16 bertrand 22: *
1.10 bertrand 23: * .. Scalar Arguments ..
24: * INTEGER ISPEC
25: * REAL ONE, ZERO
26: * ..
1.16 bertrand 27: *
1.10 bertrand 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: *
1.16 bertrand 73: *> \author Univ. of Tennessee
74: *> \author Univ. of California Berkeley
75: *> \author Univ. of Colorado Denver
76: *> \author NAG Ltd.
1.10 bertrand 77: *
1.16 bertrand 78: *> \date December 2016
1.10 bertrand 79: *
1.16 bertrand 80: *> \ingroup OTHERauxiliary
1.10 bertrand 81: *
82: * =====================================================================
1.1 bertrand 83: INTEGER FUNCTION IEEECK( ISPEC, ZERO, ONE )
84: *
1.16 bertrand 85: * -- LAPACK auxiliary routine (version 3.7.0) --
1.1 bertrand 86: * -- LAPACK is a software package provided by Univ. of Tennessee, --
87: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
1.16 bertrand 88: * December 2016
1.1 bertrand 89: *
90: * .. Scalar Arguments ..
91: INTEGER ISPEC
92: REAL ONE, ZERO
93: * ..
94: *
1.9 bertrand 95: * =====================================================================
96: *
1.1 bertrand 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: *
1.5 bertrand 170: NAN6 = NAN5*ZERO
1.1 bertrand 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
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to ieeeck.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / lapack / lapack