 |
LAPACK 3.3.1
Linear Algebra PACKage
|
|
LAPACK 3.3.1
Linear Algebra PACKage
|
00001 INTEGER FUNCTION IEEECK( ISPEC, ZERO, ONE ) 00002 * 00003 * -- LAPACK auxiliary routine (version 3.3.1) -- 00004 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00005 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00006 * -- April 2011 -- 00007 * 00008 * .. Scalar Arguments .. 00009 INTEGER ISPEC 00010 REAL ONE, ZERO 00011 * .. 00012 * 00013 * Purpose 00014 * ======= 00015 * 00016 * IEEECK is called from the ILAENV to verify that Infinity and 00017 * possibly NaN arithmetic is safe (i.e. will not trap). 00018 * 00019 * Arguments 00020 * ========= 00021 * 00022 * ISPEC (input) INTEGER 00023 * Specifies whether to test just for inifinity arithmetic 00024 * or whether to test for infinity and NaN arithmetic. 00025 * = 0: Verify infinity arithmetic only. 00026 * = 1: Verify infinity and NaN arithmetic. 00027 * 00028 * ZERO (input) REAL 00029 * Must contain the value 0.0 00030 * This is passed to prevent the compiler from optimizing 00031 * away this code. 00032 * 00033 * ONE (input) REAL 00034 * Must contain the value 1.0 00035 * This is passed to prevent the compiler from optimizing 00036 * away this code. 00037 * 00038 * RETURN VALUE: INTEGER 00039 * = 0: Arithmetic failed to produce the correct answers 00040 * = 1: Arithmetic produced the correct answers 00041 * 00042 * ===================================================================== 00043 * 00044 * .. Local Scalars .. 00045 REAL NAN1, NAN2, NAN3, NAN4, NAN5, NAN6, NEGINF, 00046 $ NEGZRO, NEWZRO, POSINF 00047 * .. 00048 * .. Executable Statements .. 00049 IEEECK = 1 00050 * 00051 POSINF = ONE / ZERO 00052 IF( POSINF.LE.ONE ) THEN 00053 IEEECK = 0 00054 RETURN 00055 END IF 00056 * 00057 NEGINF = -ONE / ZERO 00058 IF( NEGINF.GE.ZERO ) THEN 00059 IEEECK = 0 00060 RETURN 00061 END IF 00062 * 00063 NEGZRO = ONE / ( NEGINF+ONE ) 00064 IF( NEGZRO.NE.ZERO ) THEN 00065 IEEECK = 0 00066 RETURN 00067 END IF 00068 * 00069 NEGINF = ONE / NEGZRO 00070 IF( NEGINF.GE.ZERO ) THEN 00071 IEEECK = 0 00072 RETURN 00073 END IF 00074 * 00075 NEWZRO = NEGZRO + ZERO 00076 IF( NEWZRO.NE.ZERO ) THEN 00077 IEEECK = 0 00078 RETURN 00079 END IF 00080 * 00081 POSINF = ONE / NEWZRO 00082 IF( POSINF.LE.ONE ) THEN 00083 IEEECK = 0 00084 RETURN 00085 END IF 00086 * 00087 NEGINF = NEGINF*POSINF 00088 IF( NEGINF.GE.ZERO ) THEN 00089 IEEECK = 0 00090 RETURN 00091 END IF 00092 * 00093 POSINF = POSINF*POSINF 00094 IF( POSINF.LE.ONE ) THEN 00095 IEEECK = 0 00096 RETURN 00097 END IF 00098 * 00099 * 00100 * 00101 * 00102 * Return if we were only asked to check infinity arithmetic 00103 * 00104 IF( ISPEC.EQ.0 ) 00105 $ RETURN 00106 * 00107 NAN1 = POSINF + NEGINF 00108 * 00109 NAN2 = POSINF / NEGINF 00110 * 00111 NAN3 = POSINF / POSINF 00112 * 00113 NAN4 = POSINF*ZERO 00114 * 00115 NAN5 = NEGINF*NEGZRO 00116 * 00117 NAN6 = NAN5*ZERO 00118 * 00119 IF( NAN1.EQ.NAN1 ) THEN 00120 IEEECK = 0 00121 RETURN 00122 END IF 00123 * 00124 IF( NAN2.EQ.NAN2 ) THEN 00125 IEEECK = 0 00126 RETURN 00127 END IF 00128 * 00129 IF( NAN3.EQ.NAN3 ) THEN 00130 IEEECK = 0 00131 RETURN 00132 END IF 00133 * 00134 IF( NAN4.EQ.NAN4 ) THEN 00135 IEEECK = 0 00136 RETURN 00137 END IF 00138 * 00139 IF( NAN5.EQ.NAN5 ) THEN 00140 IEEECK = 0 00141 RETURN 00142 END IF 00143 * 00144 IF( NAN6.EQ.NAN6 ) THEN 00145 IEEECK = 0 00146 RETURN 00147 END IF 00148 * 00149 RETURN 00150 END
1.7.3 
