c@427: /* ieeeck.f -- translated by f2c (version 20061008).
c@427:    You must link the resulting object file with libf2c:
c@427: 	on Microsoft Windows system, link with libf2c.lib;
c@427: 	on Linux or Unix systems, link with .../path/to/libf2c.a -lm
c@427: 	or, if you install libf2c.a in a standard place, with -lf2c -lm
c@427: 	-- in that order, at the end of the command line, as in
c@427: 		cc *.o -lf2c -lm
c@427: 	Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
c@427: 
c@427: 		http://www.netlib.org/f2c/libf2c.zip
c@427: */
c@427: 
c@427: #include "f2c.h"
c@427: #include "blaswrap.h"
c@427: 
c@427: integer ieeeck_(integer *ispec, real *zero, real *one)
c@427: {
c@427:     /* System generated locals */
c@427:     integer ret_val;
c@427: 
c@427:     /* Local variables */
c@427:     real nan1, nan2, nan3, nan4, nan5, nan6, neginf, posinf, negzro, newzro;
c@427: 
c@427: 
c@427: /*  -- LAPACK auxiliary routine (version 3.2) -- */
c@427: /*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
c@427: /*     November 2006 */
c@427: 
c@427: /*     .. Scalar Arguments .. */
c@427: /*     .. */
c@427: 
c@427: /*  Purpose */
c@427: /*  ======= */
c@427: 
c@427: /*  IEEECK is called from the ILAENV to verify that Infinity and */
c@427: /*  possibly NaN arithmetic is safe (i.e. will not trap). */
c@427: 
c@427: /*  Arguments */
c@427: /*  ========= */
c@427: 
c@427: /*  ISPEC   (input) INTEGER */
c@427: /*          Specifies whether to test just for inifinity arithmetic */
c@427: /*          or whether to test for infinity and NaN arithmetic. */
c@427: /*          = 0: Verify infinity arithmetic only. */
c@427: /*          = 1: Verify infinity and NaN arithmetic. */
c@427: 
c@427: /*  ZERO    (input) REAL */
c@427: /*          Must contain the value 0.0 */
c@427: /*          This is passed to prevent the compiler from optimizing */
c@427: /*          away this code. */
c@427: 
c@427: /*  ONE     (input) REAL */
c@427: /*          Must contain the value 1.0 */
c@427: /*          This is passed to prevent the compiler from optimizing */
c@427: /*          away this code. */
c@427: 
c@427: /*  RETURN VALUE:  INTEGER */
c@427: /*          = 0:  Arithmetic failed to produce the correct answers */
c@427: /*          = 1:  Arithmetic produced the correct answers */
c@427: 
c@427: /*     .. Local Scalars .. */
c@427: /*     .. */
c@427: /*     .. Executable Statements .. */
c@427:     ret_val = 1;
c@427: 
c@427:     posinf = *one / *zero;
c@427:     if (posinf <= *one) {
c@427: 	ret_val = 0;
c@427: 	return ret_val;
c@427:     }
c@427: 
c@427:     neginf = -(*one) / *zero;
c@427:     if (neginf >= *zero) {
c@427: 	ret_val = 0;
c@427: 	return ret_val;
c@427:     }
c@427: 
c@427:     negzro = *one / (neginf + *one);
c@427:     if (negzro != *zero) {
c@427: 	ret_val = 0;
c@427: 	return ret_val;
c@427:     }
c@427: 
c@427:     neginf = *one / negzro;
c@427:     if (neginf >= *zero) {
c@427: 	ret_val = 0;
c@427: 	return ret_val;
c@427:     }
c@427: 
c@427:     newzro = negzro + *zero;
c@427:     if (newzro != *zero) {
c@427: 	ret_val = 0;
c@427: 	return ret_val;
c@427:     }
c@427: 
c@427:     posinf = *one / newzro;
c@427:     if (posinf <= *one) {
c@427: 	ret_val = 0;
c@427: 	return ret_val;
c@427:     }
c@427: 
c@427:     neginf *= posinf;
c@427:     if (neginf >= *zero) {
c@427: 	ret_val = 0;
c@427: 	return ret_val;
c@427:     }
c@427: 
c@427:     posinf *= posinf;
c@427:     if (posinf <= *one) {
c@427: 	ret_val = 0;
c@427: 	return ret_val;
c@427:     }
c@427: 
c@427: 
c@427: 
c@427: 
c@427: /*     Return if we were only asked to check infinity arithmetic */
c@427: 
c@427:     if (*ispec == 0) {
c@427: 	return ret_val;
c@427:     }
c@427: 
c@427:     nan1 = posinf + neginf;
c@427: 
c@427:     nan2 = posinf / neginf;
c@427: 
c@427:     nan3 = posinf / posinf;
c@427: 
c@427:     nan4 = posinf * *zero;
c@427: 
c@427:     nan5 = neginf * negzro;
c@427: 
c@427:     nan6 = nan5 * 0.f;
c@427: 
c@427:     if (nan1 == nan1) {
c@427: 	ret_val = 0;
c@427: 	return ret_val;
c@427:     }
c@427: 
c@427:     if (nan2 == nan2) {
c@427: 	ret_val = 0;
c@427: 	return ret_val;
c@427:     }
c@427: 
c@427:     if (nan3 == nan3) {
c@427: 	ret_val = 0;
c@427: 	return ret_val;
c@427:     }
c@427: 
c@427:     if (nan4 == nan4) {
c@427: 	ret_val = 0;
c@427: 	return ret_val;
c@427:     }
c@427: 
c@427:     if (nan5 == nan5) {
c@427: 	ret_val = 0;
c@427: 	return ret_val;
c@427:     }
c@427: 
c@427:     if (nan6 == nan6) {
c@427: 	ret_val = 0;
c@427: 	return ret_val;
c@427:     }
c@427: 
c@427:     return ret_val;
c@427: } /* ieeeck_ */