subroutine aptbtod (nbase, idiga, ndiga, idmax, iemax,
& ideca, fdeca, floga, nerr)
ccbeg.
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c SUBROUTINE APTBTOD
c
c call aptbtod (nbase, idiga, ndiga, idmax, iemax,
c & ideca, fdeca, floga, nerr)
c
c Version: aptbtod Updated 2006 May 22 15:00.
c aptbtod Originated 2005 May 20 14:00.
c
c Author: Arthur L. Edwards, LLNL, L-298, Telephone (925) 422-4123.
c
c
c Purpose: For the big integer "a", stored as the base nbase array of
c ndiga non-negative digits idiga(n), n = 1, ndiga,
c to find its non-negative decimal integer value ideca,
c if < 10^idmax, its non-negative floating point decimal value
c fdeca, if < 10^iemax, and its base 10 logarithm floga.
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 the integer array idiga from ideca, call aptdtob.
c Flag nerr indicates any input error.
c
c See aptdtob, aptbadd, aptbsub, aptbmul, aptbdiv, aptbpow,
c aptbrev, aptbrtn, aptbfac.
c
c Input: nbase, idiga, ndiga.
c
c Output: ideca, fdeca, floga, nerr.
c
c Glossary:
c
c fdeca Output The non-negative decimal floating point value of "a".
c If requiring an exponent exceeding iemax, returned
c as -1.e99.
c
c floga Output The base 10 logarithm of the decimal value of "a".
c If the latter is not positive, returned as -99.0.
c
c ideca Output The non-negative decimal integer value of "a".
c If requiring more than idmax digits, returned as
c -999999.
c
c idiga Input The big number "a", stored as an array of ndiga
c integers, each representing a single "digit" in the
c base nbase representation of the decimal integer
c ideca, in order from most to least significant.
c If nbase exceeds 10, each "digit" may require 2 or
c more integers. For example, for ideca = 4821
c (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 idmax Input The maximum number of decimal digits that will fit
c in an integer machine word.
c
c iemax Input The maximum exponent that a floating point machine word
c may have.
c
c nbase Input The number base used for the digits of integer array
c idiga. These digits are the coefficients of the
c powers of nbase, in order from most to least
c significant.
c
c ndiga Input The number if digits in the integer array idiga.
c Must not be negative.
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 ndiga is negative.
c 3 if any digits of idiga are negative.
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
ccend.
c.... Dimensioned arguments.
integer idiga(1)
c.... Local variables.
integer n
integer nbeg
integer ndigax
integer nequiv
integer npow
real fdeca
real fidmax
real flogn
real fnbase
real fpow
cbugc***DEBUG begins.
cbug 9901 format (/ 'aptbtod translating the base nbase integer array',
cbug & ' idiga, with' /
cbug & ' ndiga digits in order from most to least significant.' /
cbug & ' into decimal integer ideca.' /
cbug & ' nbase =',i7,' ndiga =',i20 )
cbug 9902 format ('bint a ',1x,i6,' = ',25i2)
cbug write ( 3, 9901) nbase, ndiga
cbug if (ndiga .gt. 0) then
cbug do nin = 1, ndiga, 25
cbug nlast = min (nin + 24, ndiga)
cbug write ( 3, 9902) nin, (idiga(n), n = nin, nlast)
cbug enddo
cbug endif
cbugc***DEBUG ends.
c.... Initialize.
c.... Change to least significant digit first.
call aptbrev (idiga, ndiga, nerrb)
c.... Test for input errors.
nerr = 0
if (nbase .lt. 2) then
nerr = 1
go to 210
endif
if (ndiga .lt. 0) then
nerr = 2
go to 210
endif
if (ndiga .ge. 1) then
do n = 1, ndiga
if (idiga(n) .lt. 0) then
nerr = 3
go to 210
endif
enddo
endif
if (ndiga .eq. 0) then
ideca = 0
fdeca = 0.0
floga = -99.0
go to 210
endif
c.... Find the base 10 logarithm of "a", floga.
c.... Find the number of base nbase digits equivalent to idmax decimal digits.
fnbase = nbase
flogn = log10 (fnbase)
fidmax = idmax
nequiv = fidmax / flogn
c.... Find the part of "a" to evaluate.
nbeg = ndiga - nequiv + 1
if (nbeg .lt. 1) nbeg = 1
ndigax = ndiga - nbeg + 1
c.... Find the decimal value of the final part of "a", fduse.
fduse = 0.0
fpow = 1.0
do n = 1, ndigax
fdiga = idiga(nbeg+n-1)
fduse = fduse + fdiga * fpow
fpow = fpow * fnbase
enddo
c.... Find the base 10 logarithm of "a", floga.
if (fduse .le. 0.0) then
floga = -99.0
else
floga = log10 (fduse) + (nbeg - 1) * flogn
endif
iloga = floga + 0.5
c.... Find the decimal floating point value of "a", fdeca.
if (iloga .lt. iemax) then
fdeca = 0.0
fpow = 1.0
do n = 1, ndiga
fdiga = idiga(n)
fdeca = fdeca + fdiga * fpow
fpow = fpow * fnbase
enddo
else
fdeca = -1.e99
endif
c.... Find the decimal integer value of "a", ideca.
if (iloga .le. idmax) then
ideca = 0
npow = 1
do n = 1, ndiga
ideca = ideca + idiga(n) * npow
npow = npow * nbase
enddo
else
ideca = -999999
endif
210 continue
c.... Change to most significant digit first.
call aptbrev (idiga, ndiga, nerrb)
cbugc***DEBUG begins.
cbug 9911 format (/ 'aptbtod results: nerr=',i2,'.')
cbug 9912 format (' ideca =',i20,' fdeca =',1pe26.18 /
cbug & ' floga =',1pe26.18)
cbug write ( 3, 9911) nerr
cbug write ( 3, 9912) ideca, fdeca, floga
cbugc***DEBUG ends.
return
c.... End of subroutine aptbtod. (+1 line.)
end
UCRL-WEB-209832