subroutine aptchfs (asrce, nchara, isrce, nchar, asym, nsym, isym, & nerr) ccbeg. cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c c SUBROUTINE APTCHFS c c call aptchfs (asrce, nchara, isrce, nchar, asym, nsym, isym, nerr) c c Version: aptchfs Updated 1992 March 5 14:20. c aptchfs Originated 1992 March 5 14:20. c c Author: Arthur L. Edwards, LLNL, L-298, Telephone (925) 422-4123. c c c Purpose: To search in character string asrce, of length nchara, within c the substring starting at character isrce, of length nchar, for c the first delimited occurrence, if any, of the character string c asym, with length lsym. A delimiter is either a boundary of c asrce, or any non-alphabetic, non-numeric character. c The character position in asrce of any delimited matching string c is returned in isym. Flag nerr indicates any input error. c c Input: asrce, nchara, isrce, nchar, asym, nsym. c c Output: isym, nerr. c c Calls: aptchfp c c Glossary: c c asrce Input A string of nchara characters, containing a substring c of nchar characters beginning at position isrce, c counting from 1 at the leftmost character. c c asym Input A character string of length nsym. A delimited c occurrence of asym will be searched for in the c substring in asrce. Both ends of the occurrence must c either be at a boundary of asrce, or adjacent to a c delimiter character, which is any non-alphabetic, c non-numeric character. c c isym Output Character position in asrce at which the first c delimited occurrence of asym begins, if any. c If no match is found, isym = 0. Otherwise, isym will c be between isrce and isrce + nchar - nsym. c c isrce Input The character position in array asrce of the first c character of the substring to be searched. c E. g., 1 for the leftmost character of asrce(1). c Must be positive. c c nchar Input The length of the substring in asrce to be searched. c Must be positive. c c nchara Input The character position of the rightmost boundary of c asrce. Must be at least isrce + nchar - 1. c c nerr Output Indicates an input error, if not zero. c 1 if nchara is less than isrce + nchar - 1. c 2 if isrce is not positive. c 3 if nchar is not positive. c 4 if nsym is not positive. c c nsym Input The number of characters in character string asym. c Must be positive. No symbol match is possible if c nsym exceeds nchar. c cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc ccend. c.... Dimensioned arguments. c---- Array containing a character string. dimension asrce (1) c---- Array containing a character string. character asrce*1 c---- Character string to be searched for. dimension asym (1) c---- Character string to be searched for. character asym*1 c.... Local variables. c---- Characters that are not delimiters. dimension achar (62) c---- Characters that are not delimiters. character*1 achar data achar / '1', '2', '3', '4', '5', '6', '7', '8', '9', '0', & 'a', 'b', 'c', 'd', 'e', 'f', 'g', 'h', 'i', 'j', & 'k', 'l', 'm', 'n', 'o', 'p', 'q', 'r', 's', 't', & 'u', 'v', 'w', 'x', 'y', 'z' , & 'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J', & 'K', 'L', 'M', 'N', 'O', 'P', 'Q', 'R', 'S', 'T', & 'U', 'V', 'W', 'X', 'Y', 'Z' / c---- Match index in achar. common /laptchfs/ ichar c---- Index in asrce. common /laptchfs/ n c---- Index in asym. common /laptchfs/ np cbugc***DEBUG begins. cbugc---- Number of character of asrce to write. cbug common /laptchfs/ nmaxa cbug 9901 format (/ 'aptchfs finding a delimited character string.' / cbug & ' nchara=',i6,' isrce=',i6,' nchar=',i6,' nsym=',i6) cbug 9902 format (' asrce=',64a1) cbug 9903 format (' asym =',64a1) cbug 9904 format (8x,'c2-4-6-8(1)2-4-6-8(2)2-4-6-8(3)2') cbug write ( 3, 9901) nchara, isrce, nchar, nsym cbug nmaxa = 8 * (1 + (nchara - 1) / 8) cbug write ( 3, 9902) (asrce(n), n = 1, nmaxa) cbug write ( 3, 9902) (asrce(n), n = isrce, isrce + nchar - 1) cbug write ( 3, 9903) (asym(n), n = 1, nsym) cbug write ( 3, 9904) cbugc***DEBUG ends. c.... initialize. isym = 0 nerr = 0 c.... Test for input errors. if (nchara .lt. (isrce + nchar - 1)) then nerr = 1 go to 210 endif if (isrce .le. 0) then nerr = 2 go to 210 endif if (nchar .le. 0) then nerr = 3 go to 210 endif if (nsym .le. 0) then nerr = 4 go to 210 endif c.... Search the specified string in asrce for symbol asym. if (nsym .gt. nchar) go to 210 c++++ Loop over substring in asrce. do 120 n = isrce, isrce + nchar - nsym do 110 np = 1, nsym c++++ No match. if (asrce(n+np-1) .ne. asym(np)) go to 120 110 continue c.... Found a match. Test for delimiter on left. if (n .gt. 1) then call aptchfp (achar, 1, 62, asrce(n-1), 1, ichar, nerr) c++++ Not a delimiter. if (ichar .ne. 0) go to 120 endif c.... Found delimiter on left. Test for delimiter on right. if ((n + nsym - 1) .lt. nchara) then call aptchfp (achar, 1, 62, asrce(n+nsym), 1, ichar, nerr) c++++ Not a delimiter. if (ichar .ne. 0) go to 120 endif c.... Found a delimited match of asym. isym = n go to 210 c---- End of loop over substring in asrce. 120 continue 210 continue cbugc***DEBUG begins. cbug 9905 format (/ 'aptchfs results: isym=',i3,' nerr=',i2) cbug write ( 3, 9905) isym, nerr cbugc***DEBUG ends. return c.... End of subroutine aptchfs. (+1 line.) end UCRL-WEB-209832