subroutine aptbmul (nbase, idiga, ndiga, idigb, ndigb,
& idigcw, ndigm, idigc, ndigc, nerr)
ccbeg.
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c SUBROUTINE APTBMUL
c
c call aptbmul (nbase, idiga, ndiga, idigb, ndigb,
c & idigcw, ndigm, idigc, ndigc, nerr)
c
c Version: aptbmul Updated 2006 May 12 13:40.
c aptbmul Originated 2005 May 23 14:50.
c
c Author: Arthur L. Edwards, LLNL, L-298, Telephone (925) 422-4123.
c
c
c Purpose: To multiply the big integers "a" and "b", stored as the arrays
c of non-negative base nbase digits idiga and idigb,
c of lengths ndiga and ndigb, respectively, to get the array
c of non-negative base nbase digits idigc, of length ndigc.
c The digits of idiga, idigb and idigc are the base nbase
c digits representing the non-negative decimal integers ideca,
c idecb and idecc, in order from most significant to least
c significant, using the equations:
c ideca = sum (idiga(n) * nbase^(N-n), n = 1, N = ndiga)
c idecb = sum (idigb(n) * nbase^(N-n), n = 1, N = ndigb)
c idecc = sum (idigc(n) * nbase^(N-n), n = 1, N = ndigc)
c Flag nerr indicates any input error.
c
c See aptbtod, aptdtob, aptbadd, aptbsub, aptbdiv, aptbpow,
c aptbrev, aptbrtn, aptbfac.
c
c Input: nbase, idiga, ndiga, idigb, ndigb, idigcw, ndigm.
c
c Output: idigc, ndigc, nerr.
c
c Glossary:
c
c idiga Input A big integer "a", stored as an array of ndiga
c non-negative base nbase digits, each representing a
c single "digit" in the base nbase representation of
c "a", from most to least significant. If nbase > 10,
c each "digit" may require 2 or more integers.
c For example, for decimal integer 4821 and
c nbase = 16 (hexadecimal), idiga(n) = (5, 13, 2, 1),
c with ndiga = 4, or
c 4821 (dec) = 5 * 1 + 13 * 16 + 2 * 256 + 1 * 4096
c
c idigb Input See idiga. Array idigb may be idiga or idigc.
c
c idigc Output See idiga. Array idigc may be idiga or idigb.
c
c idigcw Input See idiga. Temporary working space for idigc.
c Array idigcw must not be idiga, idigb or idigc,
c but must have its own memory space, which must be
c at least ndigm.
c
c nbase Input The number base for which the digits of integer arrays
c idiga, idigb and idigc are the coefficients of
c the powers of nbase, in order from most to least
c significant.
c
c ndiga Input The length of the integer array idiga.
c
c ndigb Input The length of the integer array idigb.
c
c ndigc Output The length of the integer array idigc.
c
c ndigm Input The maximum number of words allowed in integer array
c idigc. Memory space for idigc must be at least
c ndigm, and ndigm must be at least as big as
c ndiga + ndigb + 1.
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 4 if ndigb is negative.
c 5 if any digits of idigb are negative.
c 6 if ndigc exceeds ndigm.
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
ccend.
c.... Arguments.
integer idiga(1)
integer idigb(1)
integer idigc(1)
integer idigcw(1)
integer nbase
integer ndiga
integer ndigb
integer ndigc
integer ndigm
integer ndigcw
integer nerr
c.... Local variables.
integer icarry
integer itotal
integer n
integer na
integer nb
integer nw
cbugc***DEBUG begins.
cbug 9900 format (/)
cbug 9901 format (/ 'aptbmul multiplying the base nbase digit arrays',
cbug & ' idiga and idigb' /
cbug & ' to get base nbase digit array idigc.' /
cbug & ' nbase =',i7,', ndiga =',i20,', ndigb =',i20'.' )
cbug 9902 format (' a n =',i7,', idiga =',i7,'.')
cbug 9903 format (' b n =',i7,', idigb =',i7,'.')
cbug 9904 format (' a n =',i7,', idiga =',i7,'.')
cbug 9906 format (' b n =',i7,', idigb =',i7,'.')
cbug 9908 format (' c n =',i7,', idigc =',i7,'.')
cbug 9914 format (/,'aptbmul nbug=',i3)
cbug write ( 3, 9901) nbase, ndiga, ndigb
cbug write ( 3, 9900)
cbug write ( 3, 9902) (n, idiga(n), n = 1, ndiga)
cbug write ( 3, 9900)
cbug write ( 3, 9903) (n, idigb(n), n = 1, ndigb)
cbug nbug = 0
cbug write ( 3, 9914) nbug
cbug write ( 3, 9900)
cbug write ( 3, 9904) (n, idiga(n), n = 1, ndiga)
cbug write ( 3, 9900)
cbug write ( 3, 9906) (n, idigb(n), n = 1, ndigb)
cbugc***DEBUG ends.
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 (ndigb .lt. 0) then
nerr = 4
go to 210
endif
if (ndiga .ge. 1) then
do n = 1, ndigb
if (idigb(n) .lt. 0) then
nerr = 5
go to 210
endif
enddo
endif
if ((ndiga + ndigb - 1) .gt. ndigm) then
nerr = 6
go to 210
endif
c.... See if "a" or "b" is zero or undefined.
if ((ndiga .eq. 0) .or. (ndigb .eq. 0)) then
go to 210
endif
c.... Initialize temporary product "cw".
ndigcw = 1
do n = 1, ndigm
idigcw(n) = 0
enddo
c.... Multiply "a" and "b" to get temporary product "cw".
cbugcbugc***DEBUG begins.
cbugcbug nbug = 3
cbugcbug write ( 3, 9914) nbug
cbugcbug write ( 3, 9900)
cbugcbug write ( 3, 9900)
cbugcbugc***DEBUG ends.
do na = 1, ndiga ! Loop over digits of array "a".
naa = ndiga + 1 - na
do nb = 1, ndigb ! Loop over digits of array "b".
nbb = ndigb + 1 - nb
nw = na + nb - 1
idigcw(nw) = idigcw(nw) + idiga(naa) * idigb(nbb)
if (idigcw(nw) .gt. 0) then
ndigcw = nw
if (ndigcw .gt. ndigm) then
nerr = 6
go to 210
endif
endif
enddo ! End of loop over digits of array "b".
enddo ! End of loop over digits of array "a".
cbugcbugc***DEBUG begins.
cbugcbug nbug = 7
cbugcbug write ( 3, 9914) nbug
cbugcbug write ( 3, 9900)
cbugcbugc***DEBUG ends.
c.... Convert temporary product "cw" to base nbase.
icarry = 0
do nw = 1, ndigcw
itotal = idigcw(nw) + icarry
idigcw(nw) = mod (itotal, nbase)
icarry = itotal / nbase
enddo
if (icarry .ne. 0) then
ndigcw = ndigcw + 1
if (ndigcw .gt. ndigm) then
nerr = 6
go to 210
endif
idigcw(ndigcw) = icarry
endif
cbugcbugc***DEBUG begins.
cbugcbug nbug = 9
cbugcbug write ( 3, 9914) nbug
cbugcbug write ( 3, 9900)
cbugcbugc***DEBUG ends.
c.... Store reversed"cw" into product "c". Zero out "cw".
ndigc = ndigcw
do n = 1, ndigc
idigc(ndigc+1-n) = idigcw(n)
idigcw(n) = 0
enddo
210 continue
cbugcbugc***DEBUG begins.
cbugcbug nbug = 10
cbugcbug write ( 3, 9914) nbug
cbugcbug write ( 3, 9900)
cbugcbug write ( 3, 9904) (n, idiga(n), n = 1, ndiga)
cbugcbug write ( 3, 9900)
cbugcbug write ( 3, 9906) (n, idigb(n), n = 1, ndigb)
cbugcbug write ( 3, 9900)
cbugcbug write ( 3, 9908) (n, idigc(n), n = 1, ndigc)
cbugcbugc***DEBUG ends.
if (nerr .ne. 0) then
ndigc = 0
do n = 1, ndigm
idigc(n) = -999999
enddo
endif
cbugc***DEBUG begins.
cbug 9911 format (/ 'aptbmul results: nerr=',i2,', ndigc =',i7,'.')
cbug 9913 format (' a*b n =',i7,', idigc =',i7,'.')
cbug write ( 3, 9911) nerr, ndigc
cbug write ( 3, 9900)
cbug write ( 3, 9913) (n, idigc(n), n = 1, ndigc)
cbugc***DEBUG ends.
return
c.... End of subroutine aptbmul. (+1 line.)
end
UCRL-WEB-209832