subroutine aptbexp (nbase, idiga, ndiga, ndigm, idmax, iemax, & idigb, ndigb, nerr) ccbeg. cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c c SUBROUTINE APTBEXP c c call aptbexp (nbase, idiga, ndiga, ndigm, idmax, iemax, c & idigb, ndigb, nerr) c c Version: aptbexp Updated 2006 June 12 17:20. c aptbexp Originated 2006 June 12 17:20. c c Author: Arthur L. Edwards, LLNL, L-298, Telephone (925) 422-4123. c c c Purpose: To find the exponential function of big integer "a", to the c nearest digit, with no more than 16 significant figures, and c return a big integer "b". Big integers "a" and "b" are stored c as the arrays of non-negative base nbase digits idiga(n), c n = 1, ndiga, and idigb(n), n = 1, ndigb, respectively, in c order from most significant to least significant: c "a" = sum (idiga(n) * nbase^(N-n), n = 1, N = ndiga). c "b" = sum (idigb(n) * nbase^(N-n), n = 1, N = ndigb). c c Flag nerr indicates any input error. c c See aptbtod, aptbadd, aptbsub, aptbmul, aptbdiv, aptbpow, c aptbrtn, aptbfac, aptftob. c c Input: nbase, idiga, ndiga, ndigm, idmax, iemax. c c Output: idigb, ndigb, nerr. c c Calls: aptbtod, aptltob c c Glossary: c c idiga Input An array of integers, each representing a single c "digit" in the base nbase representation of the c big integer "a", in order from most signigicant to c least significant. c If nbase exceeds 10, each "digit" may require 2 or c more integers. For example, for floga = 4.821E3 c (decimal), and nbase = 16 (hexadecimal), c idiga(n) = (1, 2, 13, 5 c ideca = 1 * 4096 + 2 * 256 + 13 * 16 + 5 * 1. c c idigb Output The digits of big integer "b". See idiga. 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 in which big integers "a" and "b" c are expressed. Must be 2 or more. c c ndiga Input 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 ndigb Input The number of words in the integer array idigb. c Memory space for idigb must be at least ndigm, c and ndigb may not exceed ndigm. c c ndigm Input The maximum number of words allowed in integer arrays c "a" and "b". Memory space for "a" must be at least c ndigm. 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 ndigm is less than 1. c 3 if the decimal integer form of "a" is too big. c 3 if ndigm is insufficient to store integer array c idigb. c cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc ccend. c.... Dimensioned arguments. integer idiga(1) ! Big integer "a". integer idigb(1) ! Big integer "b" = exp ("a"). cbugc***DEBUG begins. cbug 9901 format (/ 'aptbexp finding "b" = exp ("a"). ndiga =',i8, cbug & ' nbase =',i8) cbug 9902 format ('bint a ',1x,i6,' = ',25i2) cbug write ( 3, 9901) ndiga, nbase 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.... Test for input errors. nerr = 0 if (nbase .lt. 2) then nerr = 1 go to 210 endif if (ndigm .lt. 1) then nerr = 2 go to 210 endif c.... Find the integer value of the argument "a". call aptbtod (nbase, idiga, ndiga, idmax, iemax, & ideca, fdeca, floga, nerra) if (ideca .eq. -9999999) then nerr = 3 go to 210 endif c.... Find floga, the log to the base 10 of exp ("a"). ebase = exp (1.0) floga = ideca * log10 (ebase) c.... Find "b" = exp ("a"). call aptltob (floga, nbase, ndigm, idigb, ndigb, nerrl) if (nerrl .ne. 0) then nerr = 4 go to 210 endif 210 continue if (nerr .ne. 0) then ndigb = 0 do n = 1, ndigm idigb(n) = -999999 enddo endif cbugc***DEBUG begins. cbug 9911 format (/ 'aptbexp results: ndigb=',i3,', nerr=',i2,'.') cbug 9912 format ('bint b ',1x,i6,' = ',25i2) cbug write ( 3, 9911) ndigb, nerr cbug if (ndiga .gt. 0) then cbug do nin = 1, ndigb, 25 cbug nlast = min (nin + 24, ndigb) cbug write ( 3, 9912) nin, (idigb(n), n = nin, nlast) cbug enddo cbug endif cbugc***DEBUG ends. return c.... End of subroutine aptbexp. (+1 line.) end UCRL-WEB-209832