subroutine aptbitf (worda, nbitw, wordb, ib, nbits, ia, nerr)

ccbeg.
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c                             SUBROUTINE APTBITF
c
c     call aptbitf (worda, nbitw, wordb, ib, nbits, ia, nerr)
c
c     Version:  aptbitf  Updated    1997 July 30 12:50.
c               aptbitf  Originated 1992 March 4 16:40.
c
c     Author:   Arthur L. Edwards, LLNL, L-298, Telephone (925) 422-4123.
c
c
c     Purpose:  To search in worda, containing nbitw bits, for the first
c               occurrence, if any, of the bit string in wordb, beginning
c               in bit position ib, with length nbits.  The bit position in
c               worda of any matching pattern is returned in ia.
c               Flag nerr indicates any input error.
c
c     Input:    worda, nbitw, wordb, ib, nbits.
c
c     Output:   ia, nerr.
c
c     Calls: aptbite 
c
c     Glossary:
c
c     ia        Output   Bit position in worda at which the first occurrence of
c                          the bit string in wordb begins, if any.
c                          Counted from the leftmost bit, beginning with 1.
c                          If no match is found, ia = 0.  Otherwise, ia will
c                          be between 1 and 1 + nbitw - nbits.
c
c     ib        Input    Bit position in wordb at which the bit string begins.
c                          Counted from the leftmost bit, beginning with 1.
c
c     nbits     Input    The number of bits in the bit string in wordb.
c                          Must be positive.  No pattern match is possible if
c                          nbits exceeds nbitw.
c
c     nbitw     Input    The number of bits in a machine word.  Limit is 640.
c                          Must be a positive multiple of 8.
c
c     nerr      Output   Indicates an input error, if not zero.
c                          1 if nbitw is not a positive multiple of 8.
c                          2 if nbits is not positive.
c
c     worda     Input    A machine word containing nbitw bits, counted from
c                          the leftmost bit, beginning with 1.
c
c     wordb     Input    A machine word containing nbitw bits, counted from
c                          the leftmost bit, beginning with 1.  The bit string
c                          to be searched for in worda begins in bit position
c                          ib, and has a length of nbits.
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
ccend.

c.... Local variables.

      common /laptbitf/ ibita  (640)  ! Array of bits from worda.
      integer*1         ibita         ! Array of bits from worda.
      common /laptbitf/ ibitb  (640)  ! Array of bits from wordb.
      integer*1         ibitb         ! Array of bits from wordb.
      common /laptbitf/ n             ! Index in ibita.
      common /laptbitf/ nbitx         ! A positive multiple of 8.
      common /laptbitf/ nb            ! Index in the bit string.
cbugc***DEBUG begins.
cbug 9901 format (/ 'aptbitf searching worda for a bit pattern in wordb.')
cbug 9902 format ('  worda=',z16 /
cbug     &  '  wordb=',z16,'  ib='i3,'  nbits=',i3)
cbug      write ( 3, 9901)
cbug      write ( 3, 9902) worda, wordb, ib, nbits
cbugc***DEBUG ends.

c.... initialize.

      ia   = 0
      nerr = 0

c.... Test for input errors.

      nbitx = 8 + 8 * ((nbitw - 1) / 8)

      if ((nbitw .ne. nbitx) .or. (nbitw .gt. 640)) then
        nerr = 1
        go to 210
      endif

      if (nbits .le. 0) then
        nerr = 2
        go to 210
      endif

c.... See if a pattern match is possible.

      if (nbits .gt. nbitw) go to 210

c.... Find the bit expansions of worda and wordb.

      call aptbite (worda, nbitw, nbitw, ibita, nerr)

      call aptbite (wordb, nbitw, nbitw, ibitb, nerr)

c.... Search ibita for the specified bit string in ibitb.

      do 120 n = 1, 1 + nbitw - nbits

        do 110 nb = 1, nbits
          if (ibita(n+nb-1) .ne. ibitb(ib+nb-1)) go to 120
  110   continue

        ia = n
        go to 210

  120 continue

  210 continue
cbugc***DEBUG begins.
cbug 9905 format (/ 'aptbitf results:  ia=',i3,' nerr=',i2)
cbug      write ( 3, 9905) ia, nerr
cbugc***DEBUG ends.
      return

c.... End of subroutine aptbitf.      (+1 line.)
      end

UCRL-WEB-209832