subroutine aptchfp (asrce, isrce, nchar, apat, npat, ipat, nerr) ccbeg. cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c c SUBROUTINE APTCHFP c c call aptchfp (asrce, isrce, nchar, apat, npat, ipat, nerr) c c Version: aptchfp Updated 1992 March 4 14:00. c aptchfp Originated 1992 March 4 11:00. c c Author: Arthur L. Edwards, LLNL, L-298, Telephone (925) 422-4123. c c c Purpose: To search in array asrce, in the character string starting at c character position isrce, with length nchar, to find the first c occurrence, if any, of the character string apat with length c npat. The character position in asrce of any matching pattern c is returned in ipat. Flag nerr indicates any input error. c c Input: asrce, isrce, nchar, apat, npat. c c Output: ipat, nerr. c c Glossary: c c asrce Input 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 Must contain at least isrce + nchar - 1 characters. c c apat Input A character string of length npat. c c ipat Output Character position in asrce at which the first c occurrence of character string apat begins, if any. c If no match is found, ipat = 0. Otherwise, ipat will c be between isrce and isrce + nchar - npat. c c isrce Input The character position in array asrce of the first c character of the character string 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 character string in asrce to be c searched. 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 npat is not positive. c c npat Input The number of characters in character string apat. c Must be positive. No pattern match is possible if c npat 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 apat (1) c---- Character string to be searched for. character apat*1 c.... Local variables. c---- Index in asrce. common /laptchfp/ n c---- Index in apat. common /laptchfp/ np cbugc***DEBUG begins. cbugc---- Number of character of asrce to write. cbug common /laptchfp/ nmaxa cbug 9901 format (/ 'aptchfp finding a character string.' / cbug & ' isrce=',i6,' nchar=',i6) cbug 9902 format (' asrce=',64a1) cbug 9903 format (' apat =',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) isrce, nchar cbug nmaxa = 8 * (1 + (isrce + nchar - 2) / 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) (apat(n), n = 1, npat) cbug write ( 3, 9904) cbugc***DEBUG ends. c.... initialize. ipat = 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 (npat .le. 0) then nerr = 3 go to 210 endif c.... Search the specified string in asrce for pattern apat. if (npat .gt. nchar) go to 210 do 120 n = isrce, isrce + nchar - npat do 110 np = 1, npat if (asrce(n+np-1) .ne. apat(np)) go to 120 110 continue ipat = n go to 210 120 continue 210 continue cbugc***DEBUG begins. cbug 9905 format (/ 'aptchfp results: ipat=',i3,' nerr=',i2) cbug write ( 3, 9905) ipat, nerr cbugc***DEBUG ends. return c.... End of subroutine aptchfp. (+1 line.) end UCRL-WEB-209832