r9pak.f
1.18 KB
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
function r9pak (y, n)
c december 1979 edition. w. fullerton, c3, los alamos scientific lab.
c
c pack a base 2 exponent into floating point number x. this routine
c is almost the inverse of r9upak. it is not exactly the inverse,
c because abs(x) need not be between 0.5 and 1.0. if both r9pak and
c 2.0**n were known to be in range, we could compute
c r9pak = x * 2.0**n .
c
external i1mach, r1mach
data nmin, nmax / 2*0 /
data aln210 / 3.321928094 887362 e0 /
c
if (nmin.ne.0) go to 10
aln2b = 1.0
if (i1mach(10).ne.2) aln2b = r1mach(5)*aln210
nmin = aln2b*float(i1mach(12))
nmax = aln2b*float(i1mach(13))
c
10 call r9upak (y, r9pak, ny)
c
nsum = n + ny
if (nsum.lt.nmin) go to 40
if (nsum.gt.nmax) call seteru (
1 31hr9pak packed number overflows, 31, 2, 2)
c
if (nsum.eq.0) return
if (nsum.gt.0) go to 30
c
20 r9pak = 0.5*r9pak
nsum = nsum + 1
if (nsum.ne.0) go to 20
return
c
30 r9pak = 2.0*r9pak
nsum = nsum - 1
if (nsum.ne.0) go to 30
return
c
40 call seteru (32hr9pak packed number underflows, 32, 1, 0)
r9pak = 0.0
return
c
end