annotate ext/clapack/src/ieeeck.c @ 209:ccd2019190bf msvc

Some MSVC fixes, including (temporarily, probably) renaming the FFT source file to avoid getting it mixed up with the Vamp SDK one in our object dir
author Chris Cannam
date Thu, 01 Feb 2018 16:34:08 +0000
parents 45330e0d2819
children
rev   line source
Chris@202 1 /* ieeeck.f -- translated by f2c (version 20061008).
Chris@202 2 You must link the resulting object file with libf2c:
Chris@202 3 on Microsoft Windows system, link with libf2c.lib;
Chris@202 4 on Linux or Unix systems, link with .../path/to/libf2c.a -lm
Chris@202 5 or, if you install libf2c.a in a standard place, with -lf2c -lm
Chris@202 6 -- in that order, at the end of the command line, as in
Chris@202 7 cc *.o -lf2c -lm
Chris@202 8 Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
Chris@202 9
Chris@202 10 http://www.netlib.org/f2c/libf2c.zip
Chris@202 11 */
Chris@202 12
Chris@202 13 #include "f2c.h"
Chris@202 14 #include "blaswrap.h"
Chris@202 15
Chris@202 16 integer ieeeck_(integer *ispec, real *zero, real *one)
Chris@202 17 {
Chris@202 18 /* System generated locals */
Chris@202 19 integer ret_val;
Chris@202 20
Chris@202 21 /* Local variables */
Chris@202 22 real nan1, nan2, nan3, nan4, nan5, nan6, neginf, posinf, negzro, newzro;
Chris@202 23
Chris@202 24
Chris@202 25 /* -- LAPACK auxiliary routine (version 3.2) -- */
Chris@202 26 /* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
Chris@202 27 /* November 2006 */
Chris@202 28
Chris@202 29 /* .. Scalar Arguments .. */
Chris@202 30 /* .. */
Chris@202 31
Chris@202 32 /* Purpose */
Chris@202 33 /* ======= */
Chris@202 34
Chris@202 35 /* IEEECK is called from the ILAENV to verify that Infinity and */
Chris@202 36 /* possibly NaN arithmetic is safe (i.e. will not trap). */
Chris@202 37
Chris@202 38 /* Arguments */
Chris@202 39 /* ========= */
Chris@202 40
Chris@202 41 /* ISPEC (input) INTEGER */
Chris@202 42 /* Specifies whether to test just for inifinity arithmetic */
Chris@202 43 /* or whether to test for infinity and NaN arithmetic. */
Chris@202 44 /* = 0: Verify infinity arithmetic only. */
Chris@202 45 /* = 1: Verify infinity and NaN arithmetic. */
Chris@202 46
Chris@202 47 /* ZERO (input) REAL */
Chris@202 48 /* Must contain the value 0.0 */
Chris@202 49 /* This is passed to prevent the compiler from optimizing */
Chris@202 50 /* away this code. */
Chris@202 51
Chris@202 52 /* ONE (input) REAL */
Chris@202 53 /* Must contain the value 1.0 */
Chris@202 54 /* This is passed to prevent the compiler from optimizing */
Chris@202 55 /* away this code. */
Chris@202 56
Chris@202 57 /* RETURN VALUE: INTEGER */
Chris@202 58 /* = 0: Arithmetic failed to produce the correct answers */
Chris@202 59 /* = 1: Arithmetic produced the correct answers */
Chris@202 60
Chris@202 61 /* .. Local Scalars .. */
Chris@202 62 /* .. */
Chris@202 63 /* .. Executable Statements .. */
Chris@202 64 ret_val = 1;
Chris@202 65
Chris@202 66 posinf = *one / *zero;
Chris@202 67 if (posinf <= *one) {
Chris@202 68 ret_val = 0;
Chris@202 69 return ret_val;
Chris@202 70 }
Chris@202 71
Chris@202 72 neginf = -(*one) / *zero;
Chris@202 73 if (neginf >= *zero) {
Chris@202 74 ret_val = 0;
Chris@202 75 return ret_val;
Chris@202 76 }
Chris@202 77
Chris@202 78 negzro = *one / (neginf + *one);
Chris@202 79 if (negzro != *zero) {
Chris@202 80 ret_val = 0;
Chris@202 81 return ret_val;
Chris@202 82 }
Chris@202 83
Chris@202 84 neginf = *one / negzro;
Chris@202 85 if (neginf >= *zero) {
Chris@202 86 ret_val = 0;
Chris@202 87 return ret_val;
Chris@202 88 }
Chris@202 89
Chris@202 90 newzro = negzro + *zero;
Chris@202 91 if (newzro != *zero) {
Chris@202 92 ret_val = 0;
Chris@202 93 return ret_val;
Chris@202 94 }
Chris@202 95
Chris@202 96 posinf = *one / newzro;
Chris@202 97 if (posinf <= *one) {
Chris@202 98 ret_val = 0;
Chris@202 99 return ret_val;
Chris@202 100 }
Chris@202 101
Chris@202 102 neginf *= posinf;
Chris@202 103 if (neginf >= *zero) {
Chris@202 104 ret_val = 0;
Chris@202 105 return ret_val;
Chris@202 106 }
Chris@202 107
Chris@202 108 posinf *= posinf;
Chris@202 109 if (posinf <= *one) {
Chris@202 110 ret_val = 0;
Chris@202 111 return ret_val;
Chris@202 112 }
Chris@202 113
Chris@202 114
Chris@202 115
Chris@202 116
Chris@202 117 /* Return if we were only asked to check infinity arithmetic */
Chris@202 118
Chris@202 119 if (*ispec == 0) {
Chris@202 120 return ret_val;
Chris@202 121 }
Chris@202 122
Chris@202 123 nan1 = posinf + neginf;
Chris@202 124
Chris@202 125 nan2 = posinf / neginf;
Chris@202 126
Chris@202 127 nan3 = posinf / posinf;
Chris@202 128
Chris@202 129 nan4 = posinf * *zero;
Chris@202 130
Chris@202 131 nan5 = neginf * negzro;
Chris@202 132
Chris@202 133 nan6 = nan5 * 0.f;
Chris@202 134
Chris@202 135 if (nan1 == nan1) {
Chris@202 136 ret_val = 0;
Chris@202 137 return ret_val;
Chris@202 138 }
Chris@202 139
Chris@202 140 if (nan2 == nan2) {
Chris@202 141 ret_val = 0;
Chris@202 142 return ret_val;
Chris@202 143 }
Chris@202 144
Chris@202 145 if (nan3 == nan3) {
Chris@202 146 ret_val = 0;
Chris@202 147 return ret_val;
Chris@202 148 }
Chris@202 149
Chris@202 150 if (nan4 == nan4) {
Chris@202 151 ret_val = 0;
Chris@202 152 return ret_val;
Chris@202 153 }
Chris@202 154
Chris@202 155 if (nan5 == nan5) {
Chris@202 156 ret_val = 0;
Chris@202 157 return ret_val;
Chris@202 158 }
Chris@202 159
Chris@202 160 if (nan6 == nan6) {
Chris@202 161 ret_val = 0;
Chris@202 162 return ret_val;
Chris@202 163 }
Chris@202 164
Chris@202 165 return ret_val;
Chris@202 166 } /* ieeeck_ */