Update to 2.0.0 tree from current Fremantle build

[opencv] / 3rdparty / lapack / ieeeck.c

diff --git a/3rdparty/lapack/ieeeck.c b/3rdparty/lapack/ieeeck.c
new file mode 100644 (file)
index 0000000..8e4e040
--- /dev/null
+++ b/3rdparty/lapack/ieeeck.c
@@ -0,0 +1,153 @@
+#include "clapack.h"
+
+integer ieeeck_(integer *ispec, real *zero, real *one)
+{
+    /* System generated locals */
+    integer ret_val;
+
+    /* Local variables */
+    real nan1, nan2, nan3, nan4, nan5, nan6, neginf, posinf, negzro, newzro;
+
+
+/*  -- LAPACK auxiliary routine (version 3.1) -- */
+/*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
+/*     November 2006 */
+
+/*     .. Scalar Arguments .. */
+/*     .. */
+
+/*  Purpose */
+/*  ======= */
+
+/*  IEEECK is called from the ILAENV to verify that Infinity and */
+/*  possibly NaN arithmetic is safe (i.e. will not trap). */
+
+/*  Arguments */
+/*  ========= */
+
+/*  ISPEC   (input) INTEGER */
+/*          Specifies whether to test just for inifinity arithmetic */
+/*          or whether to test for infinity and NaN arithmetic. */
+/*          = 0: Verify infinity arithmetic only. */
+/*          = 1: Verify infinity and NaN arithmetic. */
+
+/*  ZERO    (input) REAL */
+/*          Must contain the value 0.0 */
+/*          This is passed to prevent the compiler from optimizing */
+/*          away this code. */
+
+/*  ONE     (input) REAL */
+/*          Must contain the value 1.0 */
+/*          This is passed to prevent the compiler from optimizing */
+/*          away this code. */
+
+/*  RETURN VALUE:  INTEGER */
+/*          = 0:  Arithmetic failed to produce the correct answers */
+/*          = 1:  Arithmetic produced the correct answers */
+
+/*     .. Local Scalars .. */
+/*     .. */
+/*     .. Executable Statements .. */
+    ret_val = 1;
+
+    posinf = *one / *zero;
+    if (posinf <= *one) {
+       ret_val = 0;
+       return ret_val;
+    }
+
+    neginf = -(*one) / *zero;
+    if (neginf >= *zero) {
+       ret_val = 0;
+       return ret_val;
+    }
+
+    negzro = *one / (neginf + *one);
+    if (negzro != *zero) {
+       ret_val = 0;
+       return ret_val;
+    }
+
+    neginf = *one / negzro;
+    if (neginf >= *zero) {
+       ret_val = 0;
+       return ret_val;
+    }
+
+    newzro = negzro + *zero;
+    if (newzro != *zero) {
+       ret_val = 0;
+       return ret_val;
+    }
+
+    posinf = *one / newzro;
+    if (posinf <= *one) {
+       ret_val = 0;
+       return ret_val;
+    }
+
+    neginf *= posinf;
+    if (neginf >= *zero) {
+       ret_val = 0;
+       return ret_val;
+    }
+
+    posinf *= posinf;
+    if (posinf <= *one) {
+       ret_val = 0;
+       return ret_val;
+    }
+
+
+
+
+/*     Return if we were only asked to check infinity arithmetic */
+
+    if (*ispec == 0) {
+       return ret_val;
+    }
+
+    nan1 = posinf + neginf;
+
+    nan2 = posinf / neginf;
+
+    nan3 = posinf / posinf;
+
+    nan4 = posinf * *zero;
+
+    nan5 = neginf * negzro;
+
+    nan6 = nan5 * 0.f;
+
+    if (nan1 == nan1) {
+       ret_val = 0;
+       return ret_val;
+    }
+
+    if (nan2 == nan2) {
+       ret_val = 0;
+       return ret_val;
+    }
+
+    if (nan3 == nan3) {
+       ret_val = 0;
+       return ret_val;
+    }
+
+    if (nan4 == nan4) {
+       ret_val = 0;
+       return ret_val;
+    }
+
+    if (nan5 == nan5) {
+       ret_val = 0;
+       return ret_val;
+    }
+
+    if (nan6 == nan6) {
+       ret_val = 0;
+       return ret_val;
+    }
+
+    return ret_val;
+} /* ieeeck_ */