Annotation of rpl/lapack/lapack/ieeeck.f, revision 1.19
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
1.19 ! bertrand 44: *> Specifies whether to test just for infinity arithmetic
1.10 bertrand 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: *> \ingroup OTHERauxiliary
1.10 bertrand 79: *
80: * =====================================================================
1.1 bertrand 81: INTEGER FUNCTION IEEECK( ISPEC, ZERO, ONE )
82: *
1.19 ! bertrand 83: * -- LAPACK auxiliary routine --
1.1 bertrand 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: *
1.9 bertrand 92: * =====================================================================
93: *
1.1 bertrand 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: *
1.5 bertrand 167: NAN6 = NAN5*ZERO
1.1 bertrand 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
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