r9upak.f
502 Bytes
subroutine r9upak (x, y, n)
c august 1980 portable edition. w. fullerton, los alamos scientific lab
c
c unpack floating point number x so that x = y * 2.0**n, where
c 0.5 .le. abs(y) .lt. 1.0 .
c
absx = abs(x)
n = 0
y = 0.0
if (x.eq.0.0) return
c
10 if (absx.ge.0.5) go to 20
n = n - 1
absx = absx*2.0
go to 10
c
20 if (absx.lt.1.0) go to 30
n = n + 1
absx = absx*0.5
go to 20
c
30 y = sign (absx, x)
return
c
end