src/numerical/slatec/fortran/d9upak.f

   1       subroutine d9upak (x, y, n)
   2 c august 1980 portable edition.  w. fullerton, los alamos scientific lab
   3 c
   4 c unpack floating point number x so that x = y * 2.0**n, where
   5 c 0.5 .le. abs(y) .lt. 1.0 .
   6 c
   7       double precision x, y, absx
   8 c
   9       absx = dabs(x)
  10       n = 0
  11       y = 0.0d0
  12       if (x.eq.0.0d0) return
  13 c
  14  10   if (absx.ge.0.5d0) go to 20
  15       n = n - 1
  16       absx = absx*2.0d0
  17       go to 10
  18 c
  19  20   if (absx.lt.1.0d0) go to 30
  20       n = n + 1
  21       absx = absx*0.5d0
  22       go to 20
  23 c
  24  30   y = dsign (absx, x)
  25       return
  26 c
  27       end