LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
ieeeck.f
Go to the documentation of this file.
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
 All Files Functions