subroutine aptdtob (ideca, nbase, ndigm, idiga, ndiga, nerr)

ccbeg.
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c                             SUBROUTINE APTDTOB
c
c     call aptdtob (ideca, nbase, ndigm, idiga, ndiga, nerr)
c
c     Version:  aptdtob  Updated    2006 June 5 20:00.
c               aptdtob  Originated 2005 May 20 14:00.
c
c     Author:   Arthur L. Edwards, LLNL, L-298, Telephone (925) 422-4123.
c
c
c     Purpose:  To translate the non-negative decimal integer ideca into the
c               big integer "a", stored as the array of ndiga non-negative
c               base nbase digits idiga(n), n = 1, ndiga.
c
c               The ndiga digits idiga are the base nbase digits
c               representing the non-negative decimal integer ideca, in order
c               from most significant to least significant, using the equation:
c               ideca = sum (idiga(n) * nbase**(N-n), n = 1, N = ndiga).
c
c               To obtain ideca from the integer array idiga, call aptbtod.
c               Flag nerr indicates any input error.
c
c               See aptbasb, aptbtod, aptbadd, aptbsub, aptbmul, aptbdiv,
c               aptbpow, aptbrtn, aptbfac.
c
c     Input:    ideca, nbase, ndigm.
c
c     Output:   idiga, ndiga, nerr.
c
c     Glossary:
c
c     ideca     Input    A decimal integer, stored in a single machine word.
c                          Must be non-negative.
c
c     idiga     Output   An array of integers, each representing a single
c                          "digit" in the base nbase representation of the
c                          decimal integer ideca, in order from most to least
c                          significant.  If nbase exceeds 10, each "digit" may
c                          require 2 or more integers.  For example, for
c                          ideca = 4821 (decimal), and nbase = 16 (hexadecimal),
c                          idiga(n) = (5, 13, 2, 1), with ndiga = 4, or
c                          ideca =  5 * 1 + 13 * 16 + 2 * 256 + 1 * 4096.
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, N = ndiga) idiga*nbase**(N-n).
c
c     nbase     Input    The number base to which decimal integer ideca will be
c                          translated.  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 + log (ideca) / log (nbase).
c
c     nerr      Output   Indicates an input or a result error, if not zero.
c                          1 if ideca is negative.
c                          2 if nbase is less than 2.
c                          3 if ndigm is less than 1.
c                          4 if ndigm is insufficient to store integer array
c                            idiga.
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
ccend.

c.... Dimensioned arguments.

      integer idiga(1)

c.... Local variables.


cbugc***DEBUG begins.
cbug 9901 format (/ 'aptdtob translating decimal integer ideca to base',
cbug     &  ' nbase,' /
cbug     &  '  with digits in idiga(n), n = 1, ndiga <= ndigm,' /
cbug     &  '  in order from least to most significant.' /
cbug     &  '  ideca =',i20,', nbase =',i10,', ndigm =',i7,'.')
cbug      write ( 3, 9901) ideca, nbase, ndigm
cbugc***DEBUG ends.

c.... Test for input errors.

      nerr = 0

      if (ideca .lt. 0) then
        nerr = 1
        go to 210
      endif

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

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

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

      icarry = ideca

      ndiga = 0

  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

  210 continue

c.... Put "a" in normal order.

      call aptbrev (idiga, ndiga, nerrbrev)

      if (nerr .ne. 0) then
        ndiga = 0
        do n = 1, ndigm
          idiga(n) = -999999
        enddo
      endif
cbugc***DEBUG begins.
cbug 9911 format (/ 'aptdtob results:  ndiga=',i3,', nerr=',i2,'.')
cbug 9912 format ('  n =',i7,', idiga =',i7,'.')
cbug      write ( 3, 9911) ndiga, nerr
cbug      write ( 3, 9912) (n, idiga(n), n = 1, ndiga)
cbugc***DEBUG ends.
      return

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

UCRL-WEB-209832