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