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