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