Statistiques
| Révision :

root / src / lapack / util / ieeeck.f @ 11

Historique | Voir | Annoter | Télécharger (3,11 ko)

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