Blame view

fvn_fnlib/r9upak.f 502 Bytes
38581db0c   daniau   git-svn-id: https...
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
        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