![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b IEEECK 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 *> \htmlonly 00009 *> Download IEEECK + dependencies 00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ieeeck.f"> 00011 *> [TGZ]</a> 00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ieeeck.f"> 00013 *> [ZIP]</a> 00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ieeeck.f"> 00015 *> [TXT]</a> 00016 *> \endhtmlonly 00017 * 00018 * Definition: 00019 * =========== 00020 * 00021 * INTEGER FUNCTION IEEECK( ISPEC, ZERO, ONE ) 00022 * 00023 * .. Scalar Arguments .. 00024 * INTEGER ISPEC 00025 * REAL ONE, ZERO 00026 * .. 00027 * 00028 * 00029 *> \par Purpose: 00030 * ============= 00031 *> 00032 *> \verbatim 00033 *> 00034 *> IEEECK is called from the ILAENV to verify that Infinity and 00035 *> possibly NaN arithmetic is safe (i.e. will not trap). 00036 *> \endverbatim 00037 * 00038 * Arguments: 00039 * ========== 00040 * 00041 *> \param[in] ISPEC 00042 *> \verbatim 00043 *> ISPEC is INTEGER 00044 *> Specifies whether to test just for inifinity arithmetic 00045 *> or whether to test for infinity and NaN arithmetic. 00046 *> = 0: Verify infinity arithmetic only. 00047 *> = 1: Verify infinity and NaN arithmetic. 00048 *> \endverbatim 00049 *> 00050 *> \param[in] ZERO 00051 *> \verbatim 00052 *> ZERO is REAL 00053 *> Must contain the value 0.0 00054 *> This is passed to prevent the compiler from optimizing 00055 *> away this code. 00056 *> \endverbatim 00057 *> 00058 *> \param[in] ONE 00059 *> \verbatim 00060 *> ONE is REAL 00061 *> Must contain the value 1.0 00062 *> This is passed to prevent the compiler from optimizing 00063 *> away this code. 00064 *> 00065 *> RETURN VALUE: INTEGER 00066 *> = 0: Arithmetic failed to produce the correct answers 00067 *> = 1: Arithmetic produced the correct answers 00068 *> \endverbatim 00069 * 00070 * Authors: 00071 * ======== 00072 * 00073 *> \author Univ. of Tennessee 00074 *> \author Univ. of California Berkeley 00075 *> \author Univ. of Colorado Denver 00076 *> \author NAG Ltd. 00077 * 00078 *> \date November 2011 00079 * 00080 *> \ingroup auxOTHERauxiliary 00081 * 00082 * ===================================================================== 00083 INTEGER FUNCTION IEEECK( ISPEC, ZERO, ONE ) 00084 * 00085 * -- LAPACK auxiliary routine (version 3.4.0) -- 00086 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00087 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00088 * November 2011 00089 * 00090 * .. Scalar Arguments .. 00091 INTEGER ISPEC 00092 REAL ONE, ZERO 00093 * .. 00094 * 00095 * ===================================================================== 00096 * 00097 * .. Local Scalars .. 00098 REAL NAN1, NAN2, NAN3, NAN4, NAN5, NAN6, NEGINF, 00099 $ NEGZRO, NEWZRO, POSINF 00100 * .. 00101 * .. Executable Statements .. 00102 IEEECK = 1 00103 * 00104 POSINF = ONE / ZERO 00105 IF( POSINF.LE.ONE ) THEN 00106 IEEECK = 0 00107 RETURN 00108 END IF 00109 * 00110 NEGINF = -ONE / ZERO 00111 IF( NEGINF.GE.ZERO ) THEN 00112 IEEECK = 0 00113 RETURN 00114 END IF 00115 * 00116 NEGZRO = ONE / ( NEGINF+ONE ) 00117 IF( NEGZRO.NE.ZERO ) THEN 00118 IEEECK = 0 00119 RETURN 00120 END IF 00121 * 00122 NEGINF = ONE / NEGZRO 00123 IF( NEGINF.GE.ZERO ) THEN 00124 IEEECK = 0 00125 RETURN 00126 END IF 00127 * 00128 NEWZRO = NEGZRO + ZERO 00129 IF( NEWZRO.NE.ZERO ) THEN 00130 IEEECK = 0 00131 RETURN 00132 END IF 00133 * 00134 POSINF = ONE / NEWZRO 00135 IF( POSINF.LE.ONE ) THEN 00136 IEEECK = 0 00137 RETURN 00138 END IF 00139 * 00140 NEGINF = NEGINF*POSINF 00141 IF( NEGINF.GE.ZERO ) THEN 00142 IEEECK = 0 00143 RETURN 00144 END IF 00145 * 00146 POSINF = POSINF*POSINF 00147 IF( POSINF.LE.ONE ) THEN 00148 IEEECK = 0 00149 RETURN 00150 END IF 00151 * 00152 * 00153 * 00154 * 00155 * Return if we were only asked to check infinity arithmetic 00156 * 00157 IF( ISPEC.EQ.0 ) 00158 $ RETURN 00159 * 00160 NAN1 = POSINF + NEGINF 00161 * 00162 NAN2 = POSINF / NEGINF 00163 * 00164 NAN3 = POSINF / POSINF 00165 * 00166 NAN4 = POSINF*ZERO 00167 * 00168 NAN5 = NEGINF*NEGZRO 00169 * 00170 NAN6 = NAN5*ZERO 00171 * 00172 IF( NAN1.EQ.NAN1 ) THEN 00173 IEEECK = 0 00174 RETURN 00175 END IF 00176 * 00177 IF( NAN2.EQ.NAN2 ) THEN 00178 IEEECK = 0 00179 RETURN 00180 END IF 00181 * 00182 IF( NAN3.EQ.NAN3 ) THEN 00183 IEEECK = 0 00184 RETURN 00185 END IF 00186 * 00187 IF( NAN4.EQ.NAN4 ) THEN 00188 IEEECK = 0 00189 RETURN 00190 END IF 00191 * 00192 IF( NAN5.EQ.NAN5 ) THEN 00193 IEEECK = 0 00194 RETURN 00195 END IF 00196 * 00197 IF( NAN6.EQ.NAN6 ) THEN 00198 IEEECK = 0 00199 RETURN 00200 END IF 00201 * 00202 RETURN 00203 END