Return to ieeeck.f CVS log

Up to [local] / rpl / lapack / lapack

En route vers la 4.4.1.

    1:       INTEGER          FUNCTION IEEECK( ISPEC, ZERO, ONE )
    2: *
    3: *  -- LAPACK auxiliary routine (version 3.3.1) --
    4: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
    5: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
    6: *  -- April 2011                                                      --
    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: *  =====================================================================
   43: *
   44: *     .. Local Scalars ..
   45:       REAL               NAN1, NAN2, NAN3, NAN4, NAN5, NAN6, NEGINF,
   46:      $                   NEGZRO, NEWZRO, POSINF
   47: *     ..
   48: *     .. Executable Statements ..
   49:       IEEECK = 1
   50: *
   51:       POSINF = ONE / ZERO
   52:       IF( POSINF.LE.ONE ) THEN
   53:          IEEECK = 0
   54:          RETURN
   55:       END IF
   56: *
   57:       NEGINF = -ONE / ZERO
   58:       IF( NEGINF.GE.ZERO ) THEN
   59:          IEEECK = 0
   60:          RETURN
   61:       END IF
   62: *
   63:       NEGZRO = ONE / ( NEGINF+ONE )
   64:       IF( NEGZRO.NE.ZERO ) THEN
   65:          IEEECK = 0
   66:          RETURN
   67:       END IF
   68: *
   69:       NEGINF = ONE / NEGZRO
   70:       IF( NEGINF.GE.ZERO ) THEN
   71:          IEEECK = 0
   72:          RETURN
   73:       END IF
   74: *
   75:       NEWZRO = NEGZRO + ZERO
   76:       IF( NEWZRO.NE.ZERO ) THEN
   77:          IEEECK = 0
   78:          RETURN
   79:       END IF
   80: *
   81:       POSINF = ONE / NEWZRO
   82:       IF( POSINF.LE.ONE ) THEN
   83:          IEEECK = 0
   84:          RETURN
   85:       END IF
   86: *
   87:       NEGINF = NEGINF*POSINF
   88:       IF( NEGINF.GE.ZERO ) THEN
   89:          IEEECK = 0
   90:          RETURN
   91:       END IF
   92: *
   93:       POSINF = POSINF*POSINF
   94:       IF( POSINF.LE.ONE ) THEN
   95:          IEEECK = 0
   96:          RETURN
   97:       END IF
   98: *
   99: *
  100: *
  101: *
  102: *     Return if we were only asked to check infinity arithmetic
  103: *
  104:       IF( ISPEC.EQ.0 )
  105:      $   RETURN
  106: *
  107:       NAN1 = POSINF + NEGINF
  108: *
  109:       NAN2 = POSINF / NEGINF
  110: *
  111:       NAN3 = POSINF / POSINF
  112: *
  113:       NAN4 = POSINF*ZERO
  114: *
  115:       NAN5 = NEGINF*NEGZRO
  116: *
  117:       NAN6 = NAN5*ZERO
  118: *
  119:       IF( NAN1.EQ.NAN1 ) THEN
  120:          IEEECK = 0
  121:          RETURN
  122:       END IF
  123: *
  124:       IF( NAN2.EQ.NAN2 ) THEN
  125:          IEEECK = 0
  126:          RETURN
  127:       END IF
  128: *
  129:       IF( NAN3.EQ.NAN3 ) THEN
  130:          IEEECK = 0
  131:          RETURN
  132:       END IF
  133: *
  134:       IF( NAN4.EQ.NAN4 ) THEN
  135:          IEEECK = 0
  136:          RETURN
  137:       END IF
  138: *
  139:       IF( NAN5.EQ.NAN5 ) THEN
  140:          IEEECK = 0
  141:          RETURN
  142:       END IF
  143: *
  144:       IF( NAN6.EQ.NAN6 ) THEN
  145:          IEEECK = 0
  146:          RETURN
  147:       END IF
  148: *
  149:       RETURN
  150:       END