subroutine aptchip (asrce, isrce, nchar, list, anull, acont, anon,
& iadd, atype, nbad, null, ncont, nona, nerr)
ccbeg.
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c SUBROUTINE APTCHIP
c
c call aptchip (asrce, isrce, nchar, list, anull, acont, anon,
c iadd, atype, nbad, null, ncont, nona, nerr)
c
c Version: aptchip Updated 1993 March 1 16:30.
c aptchip Originated 1993 March 1 16:30.
c
c Author: Arthur L. Edwards, LLNL, L-298, Telephone (925) 422-4123.
c
c
c Purpose: To test the characters in array asrce, in the character string
c starting at character position isrce in asrce, of length nchar,
c by counting and optionally returning the locations iadd and type
c atype of all non-printing characters, and optionally replacing
c any null characters with anull, any control characters with
c acont, and any non-ASCII characters with anon.
c Each character is represented in the machine by an 8-bit byte.
c Null characters are octal 000, decimal 0, hexadecimal 00.
c Control characters are octal 001-037 and 177, decimal 1-31 and
c 127, and hexadecimal 01-1F and 7F.
c Non-ASCII characters are octal 200-377, decimal 128-255, and
c hexadecimal 80-FF.
c Flag nerr indicates any input error.
c
c Note: binary data that accidentally looks like ASCII data will
c not be detected by this module.
c
C Input: asrce, isrce, nchar, list, anull, acont, anon.
c
c Output: asrce, iadd, atype, nbad, null, ncont, nona, nerr.
c
c Glossary:
c
c asrce In/Out An array containing a character string of length nchar,
c starting at the isrce'th character, counting from
c left to right, beginning with 1.
c
c acont Input Character to replace any occurrence of a control
c character in the specified character string in asrce,
c unless acont is "n".
c
c anon Input Character to replace any occurrence of a non-ASCII
c character in the specified character string in asrce,
c unless anon is "n".
c
c anull Input Character to replace any occurrence of a null
c character in the specified character string in asrce,
c unless anull is "n".
c
c atype Output Character array of types of non-printing characters
c found in asrce, returned if list = 1:
c 'null' = a null character (octal 000).
c 'cont' = an ASCII control char (octal 001-037, 177).
c 'nona' = a non-ASCII character (octal 200-377).
c The size of array atype must be at least nchar words,
c
c iadd Output Array of locations of non-printing characters found in
c asrce, returned if list = 1. The count is from
c left to right in asrce, starting with 1. The least
c possible value is isrce, and the maximum possible
c value is isrce + nchar - 1. The size of array iadd
c must be at least nchar words.
c
c list Input Option (always return the count of non-printing
c characters in nbad, null, ncont, nona):
c 0: Do not return the arrays iadd and atype.
c 1: Return the arrays iadd and atype.
c
c isrce Input The character position in array asrce of the first
c character to be tested. E. g., 1 for the leftmost
c character of asrce(1). Must be positive.
c
c nbad Output The number of non-printing characters (octal 000-037,
c 177-377) found in the character string.
c
c nchar Input The length of the character string to be tested. Must
c be positive.
c
c ncont Output The number of control characters (octal 001-037, 177)
c found in the character string.
c
c nona Output The number of non-ASCII characters (octal 200-377)
c found in the character string.
c
c null Output The number of null characters (octal 000) found in the
c character string.
c
c nerr Output Indicates an input error, if not zero.
c 1 if nchar is not positive.
c 2 if isrce is not positive.
c 3 if list is not 0 or 1.
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
ccend.
c.... Dimensioned arguments.
c---- Array containing character string.
dimension asrce (1)
character asrce*1
c---- Character positions of non-printing characters.
dimension iadd (1)
c---- Character types of non-printing characters.
dimension atype (1)
character*8 atype
c.... Scalar arguments of type character.
c---- Character to replace a null character.
character anull*1
c---- Character to replace a control character.
character acont*1
c---- Character to replace a non-ASCII character.
character anon*1
c.... Local variables.
c---- Index in character string.
common /laptchip/ n
c---- Index in list of graphic characters.
common /laptchip/ nn
c---- Character being tested.
common /laptchip/ ctest
character*1 ctest
c---- A printable character.
common /laptchip/ agood
character*1 agood
c---- Replacement character.
common /laptchip/ arep
character*1 arep
cbugc***DEBUG begins.
cbug 9010 format (/ 'aptchip finding non-printing characters in asrce.' /
cbug & ' isrce =',i6,' nchar=',i6,' list=',i3,' anull=',a1,
cbug & ' acont=',a1,' anon=',a1)
cbug 9020 format (80a1)
cbug write (3, 9010) isrce, nchar, list, anull, acont, anon
cbug if ((isrce .gt. 0) .and. (nchar .gt. 0)) then
cbug write (3, 9020) (asrce(n), n = isrce, isrce + nchar - 1)
cbug endif
cbugc***DEBUG ends.
c.... initialize.
nerr = 0
nbad = 0
null = 0
ncont = 0
nona = 0
c.... Test for input errors.
if (nchar .le. 0) then
nerr = 1
go to 210
endif
if (isrce .le. 0) then
nerr = 2
go to 210
endif
if ((list .lt. 0) .or. (list .gt. 1)) then
nerr = 3
go to 210
endif
c.... Test asrce, from character isrce to character isrce + nchar - 1.
do 120 n = 1, nchar
ntest = isrce + n - 1
ctest = asrce(ntest)
c.... See if the character is a graphic ASCII character.
do 110 nn = 32,126
agood = char (nn)
if (ctest .eq. agood) go to 120
110 continue
c.... It is a non-graphic character.
nbad = nbad + 1
c.... Test for null, non-ASCII, and control characters.
if (ctest .lt. char (1)) then
null = null + 1
arep = anull
if (list .eq. 1) then
iadd(nbad) = ntest
atype(nbad) = 'null'
endif
elseif (ctest .gt. char (127)) then
nona = nona + 1
arep = anon
if (list .eq. 1) then
iadd(nbad) = ntest
atype(nbad) = 'nona'
endif
else
ncont = ncont + 1
arep = acont
if (list .eq. 1) then
iadd(nbad) = ntest
atype(nbad) = 'cont'
endif
endif
if (arep .ne. 'n') then
asrce(ntest) = arep
endif
120 continue
210 continue
cbugc***DEBUG begins.
cbug 9030 format (/ 'aptchip results: nerr=',i2,' nbad=',i6,
cbug & ' null=',i6,' ncont=',i6,' nona=',i6)
cbug 9040 format (6(i6,2x,a4))
cbug write (3, 9030) nerr, nbad, null, ncont, nona
cbug if (list .eq. 1) then
cbug write (3, 9040) (iadd(n), atype(n), n = 1, nbad)
cbug endif
cbug if ((isrce .gt. 0) .and. (nchar .gt. 0)) then
cbug write (3, 9020) (asrce(n), n = isrce, isrce + nchar - 1)
cbug endif
cbugc***DEBUG ends.
return
c.... End of subroutine aptchip. (+1 line.)
end
UCRL-WEB-209832