subroutine aptchai (asrce, isrce, nchar, idmax, nbase, iword,
& nerr)
ccbeg.
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c SUBROUTINE APTCHAI
c
c call aptchai (asrce, isrce, nchar, idmax, nbase, iword, nerr)
c
c Version: aptchai Updated 1992 March 11 11:10.
c aptchai Originated 1992 March 11 11:10.
c
c Author: Arthur L. Edwards, LLNL, L -298, Telephone (925) 422-4123.
c
c
c Purpose: To translate the character string in asrce, starting at
c character position isrce, with length nchar, from ASCII
c characters with number base nbase, into the binary integer
c machine word iword. Flag nerr indicates any input error.
c
c Input: asrce, isrce, nchar, nbase.
c
c Output: iword, nerr.
c
c Glossary:
c
c asrce Input A character word or array, containing at least
c isrce + nchar - 1 characters. Character positions
c are counted from left to right, starting with 1.
c The character string to be translated may contain any
c number of leading blanks, a sign, up to idmax digits,
c and any number of trailing blanks.
c
c idmax Input The maximum number of digits to be translated.
c Must be positive.
c On a Cray, should not exceed 16 octal, 14 decimal
c or 12 hexadecimal digits, for a 48-bit integer.
c
c isrce Input The character position in asrce at which the character
c string begins. Must be positive.
c
c iword Output An integer, in binary machine word format. Will be
c zero, if the character string can not be translated.
c
c nbase Input The number base for the translation.
c 8 (octal). Allowed digits are 0-7.
c 10 (decimal). Allowed digits are 0-9.
c 16 (hexadecimal). Allowed digits are 0-9, a-f, A-F.
c
c nchar Input The number of characters in the character string to be
c translated. Must be positive.
c
c nerr Output Indicates an input error, if not zero.
c 1 if isrce is not positive.
c 2 if nchar is not positive.
c 3 if idmax is not positive.
c 4 if nbase is not 8, 10, or 16.
c 5 if the character string in asrce is not
c translatable as an integer.
c 6 if the number of digits in the character string,
c after any leading blanks and a sign, exceeds idmax.
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
ccend.
c.... Dimensioned arguments.
c---- Array containing character string.
dimension asrce (1)
c---- Array containing character string.
character asrce*1
c.... Local variables.
c---- Array of ASCII digits.
common /captchai/ adigit(0:15)
common /captchai/ adigix(0:15)
c---- Array of ASCII digits.
character*1 adigit
character*1 adigix
data adigit / '0', '1', '2', '3', '4', '5', '6', '7', '8', '9',
& 'a', 'b', 'c', 'd', 'e', 'f' /
data adigix / '0', '1', '2', '3', '4', '5', '6', '7', '8', '9',
& 'A', 'B', 'C', 'D', 'E', 'F' /
c---- Index in asrce.
common /laptchai/ i
c---- Index in asrce of first number.
common /laptchai/ ibeg
c---- Index in asrce of last number.
common /laptchai/ iend
c---- Index in adigit or adigix.
common /laptchai/ idig
c---- Index in asrce.
common /laptchai/ ii
c---- Sign of iword.
common /laptchai/ isign
c---- Truncated integer.
common /laptchai/ iwork
c---- Number of digits in iword.
common /laptchai/ ndigit
cbugc***DEBUG begins.
cbugc---- Number of characters of asrce to write.
cbug common /laptchai/ nmaxa
cbug 9901 format (/ 'aptchai translating ASCII to integer.' /
cbug & ' isrce=',i6,' nchar=',i3,' idmax=',i3,' nbase=',i3)
cbug 9902 format (' asrce=',8x,64a1)
cbug write ( 3, 9901) isrce, nchar, idmax, nbase
cbug nmaxa = 8 * (1 + (isrce + nchar - 2) / 8)
cbug write ( 3, 9902) (asrce(i), i = 1, nmaxa)
cbug write ( 3, 9902) (asrce(i), i = isrce, isrce + nchar - 1)
cbugc***DEBUG ends.
c.... Initialize.
iword = 0
nerr = 0
c.... Test for input errors.
if (isrce .le. 0) then
nerr = 1
go to 210
endif
if (nchar .le. 0) then
nerr = 2
go to 210
endif
if (idmax .le. 0) then
nerr = 3
go to 210
endif
if ((nbase .ne. 8) .and. (nbase .ne. 10) .and.
& (nbase .ne. 16)) then
nerr = 4
go to 210
endif
ibeg = isrce
iend = isrce + nchar - 1
c.... Skip any leading blanks.
do 110 i = ibeg, iend
if (asrce(i) .ne. ' ') then
ii = i
go to 120
endif
110 continue
c.... Character string contains only blank characters. Return iword = 0.
go to 210
c.... See if the character string begins with a minus or plus sign.
120 ibeg = ii
if (asrce(ibeg) .eq. '-') then
isign = -1
ibeg = ibeg + 1
elseif (asrce(ibeg) .eq. '+') then
isign = 1
ibeg = ibeg + 1
else
isign = 1
endif
c---- String consists only of "+" or "-".
if (ibeg .gt. iend) then
nerr = 5
go to 210
endif
c.... Translate the character string into binary integer format.
iwork = 0
ndigit = 0
c---- Loop over characters in asrce.
do 150 i = ibeg, iend
c---- Loop over allowable digits.
do 130 idig = 0, nbase - 1
if ((asrce(i) .eq. adigit(idig)) .or.
& (asrce(i) .eq. adigix(idig))) then
c.... Found an allowable digit. Update iword, up to idmax digits.
if (ndigit .lt. idmax) then
iwork = iwork * nbase + idig
ndigit = ndigit + 1
go to 150
else
c---- Too many digits.
nerr = 6
go to 210
endif
endif
c---- End of loop over allowable digits.
130 continue
c.... Found a non-digit character. Allow trailing blanks.
c---- Loop over remaining characters.
do 140 ii = i, iend
if (asrce(ii) .ne. ' ') then
c---- Found a non-allowed character.
nerr = 5
go to 210
endif
c---- End of loop over remaining characters.
140 continue
c---- Only blank characters were found.
go to 160
c---- End of loop over characters in asrce.
150 continue
c.... Translated all characters. Give iword correct sign.
160 iword = iwork * isign
210 continue
cbugc***DEBUG begins.
cbug 9903 format (/ 'aptchai results. nerr=',i3 /
cbug & ' iword=',2x,o22,2x,i20,2x,z16)
cbug write ( 3, 9903) nerr, iwork, iword, iwork
cbugc***DEBUG ends.
return
c.... End of subroutine aptchai. (+1 line.)
end
UCRL-WEB-209832