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* ===================================================================== 83 INTEGER FUNCTION IEEECK( ISPEC, ZERO, ONE ) 84* 85* -- LAPACK auxiliary routine (version 3.4.0) -- 86* -- LAPACK is a software package provided by Univ. of Tennessee, -- 87* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 88* November 2011 89* 90* .. Scalar Arguments .. 91 INTEGER ISPEC 92 REAL ONE, ZERO 93* .. 94* 95* ===================================================================== 96* 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* 170 NAN6 = NAN5*ZERO 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 204c $Id$ 205