Return to ieeeck.f CVS log

Up to [local] / rpl / lapack / lapack

Patches pour OS/2

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