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