var/external/lapack/ieeeck.inc

   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 FUNCTION IEEECK