Annotation of rpl/lapack/lapack/ieeeck.f, revision 1.1
1.1 ! bertrand 1: INTEGER FUNCTION IEEECK( ISPEC, ZERO, ONE )
! 2: *
! 3: * -- LAPACK auxiliary routine (version 3.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: * November 2006
! 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*0.0
! 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
CVSweb interface <joel.bertrand@systella.fr>