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