Annotation of rpl/lapack/lapack/ieeeck.f, revision 1.10
1.10 ! bertrand 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: *> \date November 2011
! 79: *
! 80: *> \ingroup auxOTHERauxiliary
! 81: *
! 82: * =====================================================================
1.1 bertrand 83: INTEGER FUNCTION IEEECK( ISPEC, ZERO, ONE )
84: *
1.10 ! bertrand 85: * -- LAPACK auxiliary routine (version 3.4.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.10 ! bertrand 88: * November 2011
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