aboutsummaryrefslogtreecommitdiff
path: root/sys/gio/fpnormr.x
diff options
context:
space:
mode:
authorJoseph Hunkeler <jhunkeler@gmail.com>2015-07-08 20:46:52 -0400
committerJoseph Hunkeler <jhunkeler@gmail.com>2015-07-08 20:46:52 -0400
commitfa080de7afc95aa1c19a6e6fc0e0708ced2eadc4 (patch)
treebdda434976bc09c864f2e4fa6f16ba1952b1e555 /sys/gio/fpnormr.x
downloadiraf-linux-fa080de7afc95aa1c19a6e6fc0e0708ced2eadc4.tar.gz
Initial commit
Diffstat (limited to 'sys/gio/fpnormr.x')
-rw-r--r--sys/gio/fpnormr.x40
1 files changed, 40 insertions, 0 deletions
diff --git a/sys/gio/fpnormr.x b/sys/gio/fpnormr.x
new file mode 100644
index 00000000..45ad3f2a
--- /dev/null
+++ b/sys/gio/fpnormr.x
@@ -0,0 +1,40 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <mach.h>
+
+# FP_NORMR -- Normalize a single precision number x to the value NORMX, in the
+# range [1-10). EXPON is returned such that x = normx * (10.0E0 ** expon).
+
+procedure fp_normr (x, normx, expon)
+
+real x # number to be normalized
+real normx # X normalized to the range 1-10 (output)
+int expon # exponent of normalized X
+real absx, tol
+
+begin
+ tol = EPSILONR * 10.0
+ absx = abs (x)
+ expon = 0
+
+ if (absx > 0) {
+ while (absx < (1.0E0 - tol)) {
+ absx = absx * 10.0E0
+ expon = expon - 1
+ if (absx == 0.0) { # check for underflow to zero
+ normx = 0
+ expon = 0
+ return
+ }
+ }
+ while (absx >= (10.0E0 + tol)) {
+ absx = absx / 10.0E0
+ expon = expon + 1
+ }
+ }
+
+ if (x < 0)
+ normx = -absx
+ else
+ normx = absx
+end