SRC/ieeeck.f

   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