subroutine aptbasb (nbasa, nbasb, idiga, ndiga,
& idigq, idigr, idigu, idigv,
& idigw, idigx, idigy, idigz, ndigm,
& idigb, ndigb, nerr)
ccbeg.
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c SUBROUTINE APTBASB
c
c call aptbasb (nbasa, nbasb, idiga, ndiga, idigq, idigr,
c & idigu, idigv, idigw, idigx, idigy, idigz, ndigm,
c & idigb, ndigb, nerr)
c
c Version: aptbasb Updated 2006 June 9 14:40.
c aptbasb Originated 2005 May 23 14:50.
c
c Author: Arthur L. Edwards, LLNL, L-298, Telephone (925) 422-4123.
c
c
c Purpose: To find the representation of big integer "a", initially in
c number base nbasa, in the new number base nbasb, and store the
c result in big integer "b". These big integers are stored as the
c arrays of non-negative digits idiga and idigb, of lengths ndiga
c and ndigb, respectively. Big integers "a" and "b" are in
c normal order (most significant digit first). Local big integers
c may be in reversed order (least significant digit first).
c
c Integer arrays idigq, idigr, idigu, idigv, idigw, idigx,
c idigy and idigz are needed for intermediate results, and each
c must have its own memory space, of length ndigm or more.
c
c The digits of idiga and idigb are the digits representing the
c non-negative decimal integers ideca and idecc, in order from
c most significant to least significant, using the equations:
c ideca = sum (idiga(n) * nbasa^(N-n), n = 1, N = ndiga)
c idecc = sum (idigb(n) * nbasb^(N-n), n = 1, N = ndigb)
c
c Flag nerr indicates any input error.
c
c See aptbdiv, aptbtod, aptdtob, aptbadd, aptbsub, aptbmul,
c aptbpow, aptbrtn, aptbfac.
c
c Input: nbasa, nbasb, idiga, ndiga, idigq, idigr, idigu, idigv,
c idigw, idigx, idigy, idigz, ndigm.
c
c Output: idigb, ndigb, nerr.
c
c Calls: aptbdiv, aptbrev, aptbtod, aptdtob
c
c Glossary:
c
c idiga Input Big integer "a", stored as idiga, an array of ndiga
c non-negative base nbasa digits, each representing a
c single "digit" in the base nbasa representation of
c "a". If nbasa > 10, each "digit" may require 2 or
c more integers. For example, for nbasa = 16, and
c "a" = decimal integer 4821,
c idiga(n) = (5, 13, 2, 1), ndiga = 4. This means that
c 4821 (dec) = 5 * 1 + 13 * 16 + 2 * 256 + 1 * 4096.
c
c idigb Output The representation of big integer "a", but in number
c base nbasb instead of number base nbasa.
c must have its own memory space, of length ndigm.
c See idiga.
c
c idigq-z Output Temporary arrays. The memory space for idigq through
c idigz must be at least as large as ndigm. See idiga.
c nbasa Input The number base for which the digits of integer arrays
c idiga and idigb are the coefficients of the powers of
c nbasa, in order from most to least significant.
c
c ndiga Input The length of the integer array idiga.
c Must not exceed ndigm.
c
c ndigb Output The length of the integer array idigb.
c Must not exceed ndigm.
c
c ndigm Input The maximum number of words allowed in any big integer
c arrays.
c
c nerr Output Indicates an input or a result error, if not zero.
c 1 if nbasa is less than 2.
c 2 if nbasb is less than 2.
c 3 if ndiga is negative.
c 4 if ndiga is more than ndigm.
c 5 if any digits of idiga are negative.
c 6 if ndigb is more than ndigm.
c 7 if a conversion fails.
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
ccend.
c.... Dimensioned arguments.
integer idiga(1) ! Array "a". "a" in number base nbasa.
integer idigb(1) ! Array "b". "a" in number base nbasb.
integer idigq(ndigm) ! Array "q". Quotient.
integer idigr(ndigm) ! Array "r". Remainder.
integer idigu(ndigm) ! Array "u". Temporary array.
integer idigv(ndigm) ! Array "v". Temporary array.
integer idigw(ndigm) ! Array "w". Temporary array.
integer idigx(ndigm) ! Array "x". Temporary array.
integer idigy(ndigm) ! Array "y". Temporary array.
integer idigz(ndigm) ! Array "z". Temporary array.
c.... Local variables.
cbugc***DEBUG begins.
cbug character*64 abug ! Debug comment.
cbug character*16 avarx ! Array label.
cbug 9300 format (/ 'aptbasb DEBUG. ',a64)
cbug 9900 format (/)
cbug 9901 format (/ 'aptbasb finding idiga in base ',i5,' with ndigm =',i8)
cbug 9902 format (' "a" n =',i7,', idiga =',i7,'.')
cbug 9903 format ('aptbasb DEBUG. nbug =',i5)
cbug 9909 format (' "u" n =',i7,', idigu =',i7,'.')
cbug 9908 format (' "q" n =',i7,', idigq =',i7,'.')
cbug 9906 format (' "r" n =',i7,', idigr =',i7,'.')
cbug write ( 3, 9901) nbasb, ndigm
cbug if (ndiga .le. ndigm) then
cbug write ( 3, 9900)
cbug write ( 3, 9902) (n, idiga(n), n = 1, ndiga)
cbug endif
cbugc***DEBUG ends.
cbugcbugc***DEBUG begins.
cbugcbug abug = 'Converting "a" from base nbasea to base nbasb.'
cbugcbug write ( 3, 9300) abug
cbugcbugc***DEBUG ends.
c.... Test for input errors.
cbugcbugc***DEBUG begins.
cbugcbug abug = 'Testing for errors.'
cbugcbug write ( 3, 9300) abug
cbugcbugc***DEBUG ends.
nerr = 0
if (nbasa .lt. 2) then
nerr = 1
go to 210
endif
if (nbasb .lt. 2) then
nerr = 2
go to 210
endif
if (ndiga .lt. 0) then
nerr = 3
go to 210
endif
if (ndiga .gt. ndigm) then
nerr = 4
go to 210
endif
if (ndiga .ge. 1) then
do n = 1, ndiga
if (idiga(n) .lt. 0) then
nerr = 5
go to 210
endif
enddo
endif
cbugcbugc***DEBUG begins.
cbugcbug abug = 'Found no errors.'
cbugcbug write ( 3, 9300) abug
cbugcbugc***DEBUG ends.
c.... Initialize.
ndigb = 1
do n = 1, ndigm
idigb(n) = 0
enddo
cbugcbugc***DEBUG begins.
cbugcbug abug = 'Initialized "b" to zero.'
cbugcbug write ( 3, 9300) abug
cbugcbug write ( 3, 9900)
cbugcbug write ( 3, 9914) (n, idigb(n), n = 1, ndigb)
cbugcbugc***DEBUG ends.
c.... Find nbasb in big integer form, in base nbasa. Store in "u".
call aptdtob (nbasb, nbasa, ndigm, idigu, ndigu, nerr)
cbugcbugc***DEBUG begins.
cbugcbug abug = 'Found "u", nbasb in base nbasa format.'
cbugcbug write ( 3, 9300) abug
cbugcbug write ( 3, 9900)
cbugcbug write ( 3, 9909) (n, idigu(n), n = 1, ndigu)
cbugcbugc***DEBUG ends.
c.... Find "b", the base nbasb representation of "a".
c.... Store "a" in "q".
ndigq = ndiga
do n = 1, ndiga
idigq(n) = idiga(n)
enddo
cbugcbugc***DEBUG begins.
cbugcbug abug = 'Stored "a" into initial quotient "q".'
cbugcbug write ( 3, 9300) abug
cbugcbug write ( 3, 9900)
cbugcbug write ( 3, 9908) (n, idigq(n), n = 1, ndigq)
cbugcbugc***DEBUG ends.
c.... The next (more significant) digit of "b" is the remainder of dividing
c.... "q" by "u". Store the quotient in "q" and repeat until "q" = 0.
110 continue
cbugcbugc***DEBUG begins.
cbugcbug abug = 'Return to 110 for each new digit of "b".'
cbugcbug write ( 3, 9300) abug
cbugcbug abug = 'Divides old "q" iby "u" to get new "q".'
cbugcbug write ( 3, 9300) abug
cbugcbug write ( 3, 9900)
cbugcbug write ( 3, 9908) (n, idigq(n), n = 1, ndigq)
cbugcbug write ( 3, 9900)
cbugcbug write ( 3, 9909) (n, idigu(n), n = 1, ndigu)
cbugcbugc***DEBUG ends.
call aptbdiv (nbasa, idigq, ndigq, idigu, ndigu,
& idigv, idigw, idigx, idigy, idigz, ndigm,
& idigq, ndigq, idigr, ndigr, nerr)
cbugcbugc***DEBUG begins.
cbugcbug abug = 'Divided old "q" by "u" to get new "q", "r".'
cbugcbug write ( 3, 9300) abug
cbugcbug abug = 'Residual "r" should have one word, maybe mult digits.'
cbugcbug write ( 3, 9300) abug
cbugcbug write ( 3, 9900)
cbugcbug write ( 3, 9908) (n, idigq(n), n = 1, ndigq)
cbugcbug write ( 3, 9900)
cbugcbug write ( 3, 9906) (n, idigr(n), n = 1, ndigr)
cbugcbugc***DEBUG ends.
c.... Reduce "r" to a single digit.
call aptbtod (nbasa, idigr, ndigr, idmax, iemax,
& idecr, fdecr, flogr, nerrbtod)
if (nerrbtod .ne. 0) then
nerr = 7
cbugcbugc***DEBUG begins.
cbugcbug abug = 'Could not reduce "r" to a single digit.'
cbugcbug write ( 3, 9300) abug
cbugcbug write ( 3, 9900)
cbugcbug write ( 3, 9906) (n, idigr(n), n = 1, ndigr)
cbugcbugc***DEBUG ends.
go to 210
endif
idigb(ndigb) = idecr
cbugcbugc***DEBUG begins.
cbugcbug abug = 'Stored new "r" into next digit of "b".'
cbugcbug write ( 3, 9300) abug
cbugcbug write ( 3, 9900)
cbugcbug write ( 3, 9914) (n, idigb(n), n = 1, ndigb)
cbugcbugc***DEBUG ends.
cbugcbugc***DEBUG begins.
cbugcbug abug = 'Will go to 110 if new "q" is not zero.'
cbugcbug write ( 3, 9300) abug
cbugcbug write ( 3, 9900)
cbugcbug write ( 3, 9908) (n, idigq(n), n = 1, ndigq)
cbugcbugc***DEBUG ends.
if ((ndigq .gt. 1) .or.
& ((ndigq .eq. 1) .and. (idigq(1) .gt. 0))) then
ndigb = ndigb + 1
if (ndigb .gt. ndigm) then
nerr = 6
go to 210
endif
go to 110
endif
cbugcbugc***DEBUG begins.
cbugcbug abug = 'Found "q" = 0, went to 210.'
cbugcbug write ( 3, 9300) abug
cbugcbugc***DEBUG ends.
210 continue
cbugcbugc***DEBUG begins.
cbugcbug abug = 'Got to 210. Either error or finished "b".'
cbugcbug write ( 3, 9300) abug
cbugcbugc***DEBUG ends.
c.... Put "b" in normal order (most significant digit first).
if (nerr .eq. 0) then
call aptbrev (idigb, ndigb, nerrbrev)
cbugcbugc***DEBUG begins.
cbugcbug abug = 'Put "b" into normal order.'
cbugcbug write ( 3, 9300) abug
cbugcbug write ( 3, 9900)
cbugcbug write ( 3, 9914) (n, idigb(n), n = 1, ndigb)
cbugcbugc***DEBUG ends.
endif
c.... Zero out working arrays.
do n = 1, ndigm
idigq(n) = 0
idigr(n) = 0
idigu(n) = 0
idigv(n) = 0
idigw(n) = 0
idigx(n) = 0
idigy(n) = 0
idigz(n) = 0
enddo
if (nerr .ne. 0) then
ndigb = 0
do n = 1, ndigm
idigb(n) = -999999
enddo
cbugcbugc***DEBUG begins.
cbugcbug abug = 'Found error, putting garbage into "b".'
cbugcbug write ( 3, 9300) abug
cbugcbug write ( 3, 9900)
cbugcbug write ( 3, 9914) (n, idigb(n), n = 1, ndigb)
cbugcbugc***DEBUG ends.
endif
cbugc***DEBUG begins.
cbug 9911 format (/ 'aptbasb results: nerr=',i2,', ndigb =',i7,'.')
cbug 9914 format (' "b" n =',i7,', idigb =',i7,'.')
cbug write ( 3, 9911) nerr, ndigb
cbug write ( 3, 9900)
cbug write ( 3, 9914) (n, idigb(n), n = 1, ndigb)
cbugc***DEBUG ends.
return
c.... End of subroutine aptbasb. (+1 line.)
end
UCRL-WEB-209832