subroutine aptltob (floga, nbase, ndigm, idiga, ndiga, nerr)

ccbeg.
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c                             SUBROUTINE APTLTOB
c
c     call aptltob (floga, nbase, ndigm, idiga, ndiga, nerr)
c
c     Version:  aptltob  Updated    2006 May 12 14:00.
c               aptltob  Originated 2005 July 28 14:00.
c
c     Author:   Arthur L. Edwards, LLNL, L-298, Telephone (925) 422-4123.
c
c
c     Purpose:  To translate floga, the log to the base 10 of a positive decimal
c               floating point number, into the nearest big integer "a", stored
c               as the array of ndiga non-negative base nbase digits
c               idiga(n), n = 1, ndiga.
c
c               The ndiga digits idiga are the base nbase digits
c               representing the integer ideca nearest to the non-negative
c               decimal floating point number floga, in order from most
c               significant to least significant, using the equation:
c               ideca = sum (idiga(n) * nbase^(N-n), n = 1, N = ndiga).
c
c               To obtain floga from the integer array idiga, call aptbtod.
c               Flag nerr indicates any input error.
c
c               See aptbtod, aptbadd, aptbsub, aptbmul, aptbdiv, aptbpow,
c               aptbrtn, aptbfac.
c
c     Input:    floga, nbase, ndigm.
c
c     Output:   idiga, ndiga, nerr.
c
c     Calls: aptbrev 
c
c     Glossary:
c
c     floga     Input    The log to the base 10 of a positive decimal floating
c                          point number, stored in a single machine
c                          word.  Note:  log10 (x) = log (x) / log (10), where
c                          log (x) is the log of x to any base.
c
c     idiga     Output   An array of integers, each representing a single
c                          "digit" in the base nbase representation of the
c                          integer ideca nearest to the decimal floating point
c                          number fdeca = 10.0**floga, in order from most to
c                          least significant.
c                          If nbase exceeds 10, each "digit" may require 2 or
c                          more integers.  For example, for floga = 4.821E3
c                          (decimal), and nbase = 16 (hexadecimal),
c                          idiga(n) = (1, 2, 13, 5
c                          ideca =  1 * 4096 + 2 * 256 + 13 * 16 + 5 * 1.
c
c                          In the usual hexadecimal notation 13 would be
c                          represented by the letter "D", with ideca = 12D5 hex.
c
c                          Also note the equation:
c                            ideca = sum (n = 1, ndiga) idiga*nbase**(n-1).
c
c     nbase     Input    The number base in which result idiga will be
c                          expressed.  Must be 2 or more.
c
c     ndiga     Output   The number of words in the integer array idiga.
c                          Memory space for idiga must be at least ndigm,
c                          and ndiga may not exceed ndigm.
c
c     ndigm     Input    The maximum number of words allowed in integer array
c                          idiga.  Memory space for idiga must be at least
c                          ndigm, and ndigm must be at least as big as
c                          1 + floga / log10 (nbase).
c
c     nerr      Output   Indicates an input or a result error, if not zero.
c                          1 if nbase is less than 2.
c                          2 if ndigm is less than 1.
c                          3 if ndigm is insufficient to store integer array
c                            idiga.
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
ccend.

c.... Dimensioned arguments.

      integer idiga(1)

cbugc***DEBUG begins.
cbug 9901 format (/ 'aptltob translating 10.0**floga to base nbase,' /
cbug     &  '  with digits in idiga(n), n = 1, ndiga <= ndigm,' /
cbug     &  '  in order from most to least significant.' /
cbug     &  '  floga =',1pe25.18,', nbase =',i10,', ndigm =',i7,'.')
cbug      write ( 3, 9901) floga, nbase, ndigm
cbugc***DEBUG ends.

c.... Initialize.

      ndiga = 0
      do n = 1, ndigm
        idiga(n) = 0
      enddo

c.... Test for input errors.

      nerr = 0

      if (nbase .lt. 2) then
        nerr = 1
        go to 210
      endif

      if (ndigm .lt. 1) then
        nerr = 2
        go to 210
      endif

c.... See if "a" rounds off to zero.

      flogh = log10 (0.5)

      if (floga .lt. flogh) then
        ndiga    = 1
        idiga(1) = 0
        go to 210
      endif

c.... Find biggest power of nbase needed.

      fnbase = nbase
      nmax   = floga / log10 (fnbase)
cbugcbugc***DEBUG begins.
cbugcbug 9771 format ('nmax=',i6)
cbugcbug      write ( 3, 9771) nmax
cbugcbugc***DEBUG ends.
      if (nmax .gt. ndigm) then
        nerr = 3
        go to 210
      endif

c.... Find biggest power of nbase that has 16 decimal digits.

      nuse = 16 / log10 (fnbase)
cbugcbugc***DEBUG begins.
cbugcbug 9772 format ('nuse=',i6)
cbugcbug      write ( 3, 9772) nuse
cbugcbugc***DEBUG ends.

c.... Find factor to reduce floga to 16 decimal digits.

      ndiff = nmax - nuse
      if (ndiff .lt. 1) ndiff = 0
cbugcbugc***DEBUG begins.
cbugcbug 9773 format ('ndiff=',i6)
cbugcbug      write ( 3, 9773) ndiff
cbugcbugc***DEBUG ends.

c.... Find nearest integer to reduced floating point number.

      fndiff = ndiff
      fsmall = 10.0**(floga - ndiff * log10 (fnbase))
      ismall = fsmall + 0.5
cbugcbugc***DEBUG begins.
cbugcbug 9774 format ('fsmall=',1pe25.18,'  ismall=',i20)
cbugcbug      write ( 3, 9774) fsmall, ismall
cbugcbugc***DEBUG ends.

c.... Convert decimal integer ismall to base nbase.

      icarry = ismall

c.... Find big number "a" in order from least to most significant digit.

  110 ndiga = ndiga + 1

      if (ndiga .gt. ndigm) then
        nerr = 4
        do nn = 1, ndiga
          idiga(nn) = 0
        enddo
        ndiga = 0
        go to 210
      endif

      idiga(ndiga) = mod (icarry, nbase)
      icarry = icarry / nbase
      if (icarry .gt. 0) go to 110
cbugcbugc***DEBUG begins.
cbugcbug      write ( 3, 9911) ndiga, nerr
cbugcbug      if (ndiga .gt. 0) then
cbugcbug        call aptbrev (idiga, ndiga, nerrb)
cbugcbug        do nin = 1, ndiga, 25
cbugcbug          nlast = min (nin + 24, ndiga)
cbugcbug          write ( 3, 9912) nin, (idiga(n), n = nin, nlast)
cbugcbug        enddo
cbugcbug        call aptbrev (idiga, ndiga, nerrb)
cbugcbug      endif
cbugcbugc***DEBUG ends.

c.... Multiply "a" by nbase^ndiff to restore size (shift right ndiff digits).

      do n = ndiga + ndiff, 1 + ndiff, -1
        idiga(n) = idiga(n-ndiff)
      enddo

      do n = 1, ndiff
        idiga(n) = 0
      enddo

      ndiga = ndiga + ndiff
cbugcbugc***DEBUG begins.
cbugcbug      write ( 3, 9911) ndiga, nerr
cbugcbug      if (ndiga .gt. 0) then
cbugcbug        call aptbrev (idiga, ndiga, nerrb)
cbugcbug        do nin = 1, ndiga, 25
cbugcbug          nlast = min (nin + 24, ndiga)
cbugcbug          write ( 3, 9912) nin, (idiga(n), n = nin, nlast)
cbugcbug        enddo
cbugcbug        call aptbrev (idiga, ndiga, nerrb)
cbugcbug      endif
cbugcbugc***DEBUG ends.

  210 continue

c.... Change "a" to most significant digit first.

      call aptbrev (idiga, ndiga, nerrb)

      if (nerr .ne. 0) then
        ndiga = 0
        do n = 1, ndigm
          idiga(n) = -999999
        enddo
      endif

cbugc***DEBUG begins.
cbug 9911 format (/ 'aptltob results:  ndiga=',i3,', nerr=',i2,'.')
cbug 9912 format ('bint a          ',1x,i6,' = ',25i2)
cbug      write ( 3, 9911) ndiga, nerr
cbug      if (ndiga .gt. 0) then
cbug        do nin = 1, ndiga, 25
cbug          nlast = min (nin + 24, ndiga)
cbug          write ( 3, 9912) nin, (idiga(n), n = nin, nlast)
cbug        enddo
cbug      endif
cbugc***DEBUG ends.
      return

c.... End of subroutine aptltob.      (+1 line.)
      end

UCRL-WEB-209832