src/LAPACK/ieeeck.f

   1       INTEGER          FUNCTION IEEECK( ISPEC, ZERO, ONE )
   2 *
   3 *  -- LAPACK auxiliary routine (version 3.1) --
   4 *     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
   5 *     November 2006
   6 *
   7 *     .. Scalar Arguments ..
   8       INTEGER            ISPEC
   9       REAL               ONE, ZERO
  10 *     ..
  11 *
  12 *  Purpose
  13 *  =======
  14 *
  15 *  IEEECK is called from the ILAENV to verify that Infinity and
  16 *  possibly NaN arithmetic is safe (i.e. will not trap).
  17 *
  18 *  Arguments
  19 *  =========
  20 *
  21 *  ISPEC   (input) INTEGER
  22 *          Specifies whether to test just for inifinity arithmetic
  23 *          or whether to test for infinity and NaN arithmetic.
  24 *          = 0: Verify infinity arithmetic only.
  25 *          = 1: Verify infinity and NaN arithmetic.
  26 *
  27 *  ZERO    (input) REAL
  28 *          Must contain the value 0.0
  29 *          This is passed to prevent the compiler from optimizing
  30 *          away this code.
  31 *
  32 *  ONE     (input) REAL
  33 *          Must contain the value 1.0
  34 *          This is passed to prevent the compiler from optimizing
  35 *          away this code.
  36 *
  37 *  RETURN VALUE:  INTEGER
  38 *          = 0:  Arithmetic failed to produce the correct answers
  39 *          = 1:  Arithmetic produced the correct answers
  40 *
  41 *     .. Local Scalars ..
  42       REAL               NAN1, NAN2, NAN3, NAN4, NAN5, NAN6, NEGINF,
  43      $                   NEGZRO, NEWZRO, POSINF
  44 *     ..
  45 *     .. Executable Statements ..
  46       IEEECK = 1
  47 *
  48       POSINF = ONE / ZERO
  49       IF( POSINF.LE.ONE ) THEN
  50          IEEECK = 0
  51          RETURN
  52       END IF
  53 *
  54       NEGINF = -ONE / ZERO
  55       IF( NEGINF.GE.ZERO ) THEN
  56          IEEECK = 0
  57          RETURN
  58       END IF
  59 *
  60       NEGZRO = ONE / ( NEGINF+ONE )
  61       IF( NEGZRO.NE.ZERO ) THEN
  62          IEEECK = 0
  63          RETURN
  64       END IF
  65 *
  66       NEGINF = ONE / NEGZRO
  67       IF( NEGINF.GE.ZERO ) THEN
  68          IEEECK = 0
  69          RETURN
  70       END IF
  71 *
  72       NEWZRO = NEGZRO + ZERO
  73       IF( NEWZRO.NE.ZERO ) THEN
  74          IEEECK = 0
  75          RETURN
  76       END IF
  77 *
  78       POSINF = ONE / NEWZRO
  79       IF( POSINF.LE.ONE ) THEN
  80          IEEECK = 0
  81          RETURN
  82       END IF
  83 *
  84       NEGINF = NEGINF*POSINF
  85       IF( NEGINF.GE.ZERO ) THEN
  86          IEEECK = 0
  87          RETURN
  88       END IF
  89 *
  90       POSINF = POSINF*POSINF
  91       IF( POSINF.LE.ONE ) THEN
  92          IEEECK = 0
  93          RETURN
  94       END IF
  95 *
  96 *
  97 *
  98 *
  99 *     Return if we were only asked to check infinity arithmetic
 100 *
 101       IF( ISPEC.EQ.0 )
 102      $   RETURN
 103 *
 104       NAN1 = POSINF + NEGINF
 105 *
 106       NAN2 = POSINF / NEGINF
 107 *
 108       NAN3 = POSINF / POSINF
 109 *
 110       NAN4 = POSINF*ZERO
 111 *
 112       NAN5 = NEGINF*NEGZRO
 113 *
 114       NAN6 = NAN5*0.0
 115 *
 116       IF( NAN1.EQ.NAN1 ) THEN
 117          IEEECK = 0
 118          RETURN
 119       END IF
 120 *
 121       IF( NAN2.EQ.NAN2 ) THEN
 122          IEEECK = 0
 123          RETURN
 124       END IF
 125 *
 126       IF( NAN3.EQ.NAN3 ) THEN
 127          IEEECK = 0
 128          RETURN
 129       END IF
 130 *
 131       IF( NAN4.EQ.NAN4 ) THEN
 132          IEEECK = 0
 133          RETURN
 134       END IF
 135 *
 136       IF( NAN5.EQ.NAN5 ) THEN
 137          IEEECK = 0
 138          RETURN
 139       END IF
 140 *
 141       IF( NAN6.EQ.NAN6 ) THEN
 142          IEEECK = 0
 143          RETURN
 144       END IF
 145 *
 146       RETURN
 147       END