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*> \ingroup OTHERauxiliary 79* 80* ===================================================================== 81 INTEGER FUNCTION IEEECK( ISPEC, ZERO, ONE ) 82* 83* -- LAPACK auxiliary routine -- 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* 92* ===================================================================== 93* 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* 167 NAN6 = NAN5*ZERO 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 201