subroutine aptbsub (nbase, idiga, ndiga, idigb, ndigb,
& idigcw, ndigm, idigc, ndigc, isign, nerr)
ccbeg.
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c SUBROUTINE APTBSUB
c
c call aptbsub (nbase, idiga, ndiga, idigb, ndigb,
c & idigcw, ndigm, idigc, ndigc, isign, nerr)
c
c Version: aptbsub Updated 2006 May 19 15:20.
c aptbsub Originated 2005 May 23 14:50.
c
c Author: Arthur L. Edwards, LLNL, L-298, Telephone (925) 422-4123.
c
c
c Purpose: To subtract from big integer "a", big integer "b", stored as the
c arrays of non-negative base nbase digits idiga and idigb, of
c lengths ndiga and ndigb, respectively, to get the big
c integer "c", stored as the array of non-negative base nbase
c digits idigc, of length ndigc. If "c" is negative,
c isign is returned as -1.
c
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
c Flag nerr indicates any input error.
c
c See aptbtod, aptdtob, aptbadd, aptbmul, aptbdiv, aptbpow,
c aptbrtn, aptbfac.
c
c Input: nbase, idiga, ndiga, idigb, ndigb, idigcw, ndigm.
c
c Output: idigc, ndigc, isign, nerr.
c
c Glossary:
c
c idiga Input A big integer "a", stored as an array of ndiga
c non-negative base nbase digits, in order from most
c to least significant. If nbase exceeds 10, each
c "digit" may require 2 or more integers. For example,
c for decimal integer 4821, nbase = 16 (hexadecimal),
c idiga(n) = (5, 13, 2, 1), 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 Input See idiga. Array idigc may be idiga or idigb.
c Big integer "c" is "a" - "b", unless isign = -1,
c when "c" is "b" - "a".
c
c idigcw Input Temporary working space for idigc. See idiga.
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 isign Output The sign of the result, +1 if "a" => "b",
c -1 if "b" > "a".
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 If "a" = "b", ndigc = 1, with idigc(1) = 0.
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 max (ndiga, ndigb).
c
c nerr Output Indicates an input or a result error, if not zero.
c -1 if "b" is bigger than "a".
c 1 if nbase is less than 2.
c 2 if ndiga is not positive.
c 3 if any digits of idiga are negative.
c 4 if ndigb is not positive.
c 5 if any digits of idigb are negative.
c 6 if ndigm is less than 1 + max (ndiga, ndigb).
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
ccend.
implicit none
c.... Arguments.
integer idiga(1) ! Digits of big integer "a".
integer idigb(1) ! Digits of big integer "b".
integer idigc(1) ! Digits of big integer "c".
integer idigcw(1) ! Digits of big integer "cw".
integer isign ! -1 if "b" exceedds "a".
integer nbase ! Number base of "a", "b", "c", "cw".
integer ndiga ! Number of digits of big integer "a".
integer ndigb ! Number of digits of big integer "b".
integer ndigc ! Number of digits of big integer "c".
integer ndigm ! Max number of digits of big integers.
integer nerr ! Non-zero if input error(s) found.
c.... Local variables.
integer icarry ! Integer carried to next digit.
integer itotal ! Digit difference plus carry.
integer n ! Index in arrays.
integer na ! Index in array "a".
integer nb ! Index in array "b".
integer ndigcw ! Number of digits of big integer "cw".
integer nmax ! Max number of digits in big integer "c".
integer nw ! Index in array "cw".
cbugc***DEBUG begins.
cbug 9900 format (/)
cbug 9901 format (/ 'aptbsub subtracting the base nbase digit array',
cbug & ' idigb from idiga' /
cbug & ' to get base nbase digit array idigc.' /
cbug & ' nbase =',i7,', ndiga =',i7,', ndigb =',i7,'.' )
cbug 9902 format (' a n =',i7,', idiga =',i7,'.')
cbug 9903 format (' b n =',i7,', idigb =',i7,'.')
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)
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 .gt. 0) 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 (ndigb .gt. 0) then
do n = 1, ndigb
if (idigb(n) .lt. 0) then
nerr = 5
go to 210
endif
enddo
endif
nmax = max (ndiga, ndigb)
if (nmax .gt. ndigm) then
nerr = 6
go to 210
endif
c.... Initialize.
isign = 1
c.... Initialize temporary difference "cw".
ndigcw = 1
do n = 1, ndigm
idigcw(n) = 0
enddo
c.... Subtract "b" from "a" to get temporary difference "cw".
icarry = 0
do n = 1, nmax
na = ndiga + 1 - n
nb = ndigb + 1 - n
itotal = icarry
if ((na .ge. 1) .and. (na .le. ndiga)) then
itotal = itotal + idiga(na)
endif
if ((nb .ge. 1) .and. (nb .le. ndigb)) then
itotal = itotal - idigb(nb)
endif
if (itotal .lt. 0) then
itotal = itotal + nbase
icarry = -1
else
icarry = 0
endif
idigcw(n) = itotal
if (idigcw(n) .gt. 0) then
ndigcw = n
endif
enddo
if (icarry .eq. -1) then
isign = -1
nerr = -1
ndigcw = 1
do n = 1, nmax
idigcw(n) = nbase - idigcw(n) - 1
if (idigcw(n) .gt. 0) then
ndigcw = n
endif
enddo
idigcw(1) = idigcw(1) + 1
endif
if (ndigcw .eq. 0) then
ndigcw = 1
idigcw(1) = 0
endif
c.... Convert temporary difference "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
idigcw(ndigcw) = icarry
endif
if (ndigcw .eq. 0) then
ndigcw = 1
idigcw(1) = 0
endif
c.... Store reversed difference "cw" into "c". Zero out "cw".
ndigc = ndigcw
do n = 1, ndigc
idigc(ndigc+1-n) = idigcw(n)
idigcw(n) = 0
enddo
210 continue
if (nerr .gt. 0) then
ndigc = 0
do n = 1, ndigm
idigc(n) = -999999
enddo
endif
cbugc***DEBUG begins.
cbug 9700 format (/)
cbug 9911 format (/ 'aptbsub results: nerr =',i2,', ndigc =',i7,
cbug & ', isign =',i2,'.')
cbug 9913 format (' a-b n =',i7,', idigc =',i7,'.')
cbug write ( 3, 9911) nerr, ndigc, isign
cbug write ( 3, 9700)
cbug write ( 3, 9913) (n, idigc(n), n = 1, ndigc)
cbugc***DEBUG ends.
return
c.... End of subroutine aptbsub. (+1 line.)
end
UCRL-WEB-209832