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