git.maemo.org Git - opencv/blob - 3rdparty/lapack/ieeeck.c

   1 #include "clapack.h"
   2
   3 integer ieeeck_(integer *ispec, real *zero, real *one)
   4 {
   5     /* System generated locals */
   6     integer ret_val;
   7
   8     /* Local variables */
   9     real nan1, nan2, nan3, nan4, nan5, nan6, neginf, posinf, negzro, newzro;
  10
  11
  12 /*  -- LAPACK auxiliary routine (version 3.1) -- */
  13 /*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
  14 /*     November 2006 */
  15
  16 /*     .. Scalar Arguments .. */
  17 /*     .. */
  18
  19 /*  Purpose */
  20 /*  ======= */
  21
  22 /*  IEEECK is called from the ILAENV to verify that Infinity and */
  23 /*  possibly NaN arithmetic is safe (i.e. will not trap). */
  24
  25 /*  Arguments */
  26 /*  ========= */
  27
  28 /*  ISPEC   (input) INTEGER */
  29 /*          Specifies whether to test just for inifinity arithmetic */
  30 /*          or whether to test for infinity and NaN arithmetic. */
  31 /*          = 0: Verify infinity arithmetic only. */
  32 /*          = 1: Verify infinity and NaN arithmetic. */
  33
  34 /*  ZERO    (input) REAL */
  35 /*          Must contain the value 0.0 */
  36 /*          This is passed to prevent the compiler from optimizing */
  37 /*          away this code. */
  38
  39 /*  ONE     (input) REAL */
  40 /*          Must contain the value 1.0 */
  41 /*          This is passed to prevent the compiler from optimizing */
  42 /*          away this code. */
  43
  44 /*  RETURN VALUE:  INTEGER */
  45 /*          = 0:  Arithmetic failed to produce the correct answers */
  46 /*          = 1:  Arithmetic produced the correct answers */
  47
  48 /*     .. Local Scalars .. */
  49 /*     .. */
  50 /*     .. Executable Statements .. */
  51     ret_val = 1;
  52
  53     posinf = *one / *zero;
  54     if (posinf <= *one) {
  55         ret_val = 0;
  56         return ret_val;
  57     }
  58
  59     neginf = -(*one) / *zero;
  60     if (neginf >= *zero) {
  61         ret_val = 0;
  62         return ret_val;
  63     }
  64
  65     negzro = *one / (neginf + *one);
  66     if (negzro != *zero) {
  67         ret_val = 0;
  68         return ret_val;
  69     }
  70
  71     neginf = *one / negzro;
  72     if (neginf >= *zero) {
  73         ret_val = 0;
  74         return ret_val;
  75     }
  76
  77     newzro = negzro + *zero;
  78     if (newzro != *zero) {
  79         ret_val = 0;
  80         return ret_val;
  81     }
  82
  83     posinf = *one / newzro;
  84     if (posinf <= *one) {
  85         ret_val = 0;
  86         return ret_val;
  87     }
  88
  89     neginf *= posinf;
  90     if (neginf >= *zero) {
  91         ret_val = 0;
  92         return ret_val;
  93     }
  94
  95     posinf *= posinf;
  96     if (posinf <= *one) {
  97         ret_val = 0;
  98         return ret_val;
  99     }
 100
 101
 102
 103
 104 /*     Return if we were only asked to check infinity arithmetic */
 105
 106     if (*ispec == 0) {
 107         return ret_val;
 108     }
 109
 110     nan1 = posinf + neginf;
 111
 112     nan2 = posinf / neginf;
 113
 114     nan3 = posinf / posinf;
 115
 116     nan4 = posinf * *zero;
 117
 118     nan5 = neginf * negzro;
 119
 120     nan6 = nan5 * 0.f;
 121
 122     if (nan1 == nan1) {
 123         ret_val = 0;
 124         return ret_val;
 125     }
 126
 127     if (nan2 == nan2) {
 128         ret_val = 0;
 129         return ret_val;
 130     }
 131
 132     if (nan3 == nan3) {
 133         ret_val = 0;
 134         return ret_val;
 135     }
 136
 137     if (nan4 == nan4) {
 138         ret_val = 0;
 139         return ret_val;
 140     }
 141
 142     if (nan5 == nan5) {
 143         ret_val = 0;
 144         return ret_val;
 145     }
 146
 147     if (nan6 == nan6) {
 148         ret_val = 0;
 149         return ret_val;
 150     }
 151
 152     return ret_val;
 153 } /* ieeeck_ */