subroutine aptftob (fdeca, nbase, ndigm, idiga, ndiga, nerr)
ccbeg.
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c SUBROUTINE APTFTOB
c
c call aptftob (fdeca, nbase, ndigm, idiga, ndiga, nerr)
c
c Version: aptftob Updated 2006 June 13 14:30.
c aptftob 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 floating point number
c fdeca into the nearest big integer "a", with up to 17
c significant figures, 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 representing
c the integer ideca nearest to the non-negative decimal floating
c point number fdeca, in order from most significant to least
c significant, using the equation:
c ideca = sum (idiga(n) * nbase**(N-n), n = 1, N = ndiga).
c
c To obtain fdeca 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 Calls: aptbrev
c
c Input: fdeca, nbase, ndigm.
c
c Output: idiga, ndiga, nerr.
c
c Glossary:
c
c fdeca Input A floating point number, stored in a single machine
c word. 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 integer ideca nearest to the decimal floating point
c number fdeca, in order from most to least
c significant.
c If nbase exceeds 10, each "digit" may require 2 or
c more integers. For example, for fdeca = 4.821E3
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 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 to which decimal floating point number
c fdeca will be 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 (fdeca) / log (nbase).
c
c nerr Output Indicates an input or a result error, if not zero.
c 1 if fdeca 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 (/ 'aptftob translating floating point fdeca to base',
cbug & ' nbase,' /
cbug & ' with digits in idiga(n), n = 1, ndiga <= ndigm,' /
cbug & ' in order from most to least significant.' /
cbug & ' fdeca =',1pe25.18,', nbase =',i10,', ndigm =',i7,'.')
cbug write ( 3, 9901) fdeca, nbase, ndigm
cbugc***DEBUG ends.
c.... Initialize.
ndiga = 0
do n = 1, ndigm
idiga(n) = -999999
enddo
c.... Test for input errors.
nerr = 0
if (fdeca .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.... See if fdeca is zero.
if (fdeca .eq. 0.0) then
ndiga = 1
idiga(1) = 0
go to 210
endif
c.... Find biggest power of nbase needed.
fnbase = nbase
nmax = log10 (fdeca) / log10 (fnbase)
cbugcbugc***DEBUG begins.
cbugcbug 9771 format ('nmax=',i6)
cbugcbug write ( 3, 9771) nmax
cbugcbugc***DEBUG ends.
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 divisor to reduce fdeca 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.
fsmall = fdeca / fnbase**ndiff
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
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 write ( 3, 9912) (n, idiga(n), n = 1, ndiga)
cbugcbugc***DEBUG ends.
c.... Multiple idiga by nbase**ndiff to restore size.
do n = ndiga + ndiff, 1 + ndiff, -1
idiga(n) = idiga(n-ndiff)
enddo
do n = 1, ndiff
idiga(n) = 0
enddo
ndiga = ndiga + ndiff
c.... Reverse order of "a".
call aptbrev (idiga, ndiga, nerrrev)
cbugcbugc***DEBUG begins.
cbugcbug write ( 3, 9911) ndiga, nerr
cbugcbug write ( 3, 9912) (n, idiga(n), n = 1, ndiga)
cbugcbugc***DEBUG ends.
210 continue
cbugc***DEBUG begins.
cbug 9911 format (/ 'aptftob 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 aptftob. (+1 line.)
end
UCRL-WEB-209832