subroutine aptword (lword, nwords, la, lb, mods, kbet, nerr)

ccbeg.
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c                             SUBROUTINE APTWORD
c
c     call aptword (lword, nwords, la, lb, mods, mods, kbet, nerr)
c
c     Version:  aptword  Updated    1992 May 22 14:20.
c               aptword  Originated 1990 July 30 11:40.
c
c     Author:   Arthur L. Edwards, LLNL, L-298, Telephone (925) 422-4123.
c
c
c     Purpose:  To find out if the nwords words lword are in the range from
c               la to lb, inclusive.  The mode of lword, la and lb is
c               alphanumeric (mods = 0), integer (mods = 1) or floating point
c               (mods = 2).
c               Flag nerr indicates any input errors.
c
c     Input:    lword, nwords, la, lb, mods.
c
c     Output:   kbet, nerr.
c
c     Glossary:
c
c     kbet      Output   Indicates, if 1, that nwords(n) is in the range
c                          from la to lb, inclusive.  Size nwords.
c
c     la        Input    First limit of an range.
c
c     lb        Input    Second limit of an range.
c
c     lword     Input    An array of words.  Size nwords.
c
c     mods      Input    Indicates mode of lword, la and lb:
c                          0 for alphanumeric.
c                          1 for integer.
c                          2 for floating point.
c
c     nerr      Output   Indicates any input errors, if not zero:
c                          1 if nwords is less than 1.
c                          2 if mods is not in the range from 0 to 2.
c
c     nwords    Input    The size of arrays lword and kbet.
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
ccend.

c.... Dimensioned arguments.

c---- If 1, lword between la and lb.
      dimension kbet    (1)
c---- An alphanumeric word.
      dimension lword   (1)

c.... Equivalences to arguments.

c---- ASCII string equivalent of la = lla.
      character*8 ala
c---- ASCII string equivalent of la = lla.
      equivalence (ala,    lla)

c---- ASCII string equivalent of lb = llb.
      character*8 alb
c---- ASCII string equivalent of lb = llb.
      equivalence (alb,    llb)

c---- Floating point equivalent of la = lla.
      equivalence (fla,    lla)
c---- Floating point equivalent of lb = llb.
      equivalence (flb,    llb)

c.... Local variables.

c---- Difference between ftest and fla.
      common /laptword/ fdiffa
c---- Difference between flb and ftest.
      common /laptword/ fdiffb
c---- Sign of direction from fla to flb.
      common /laptword/ fsign
c---- Difference between ltest and la.
      common /laptword/ ldiffa
c---- Difference between lb and ltest.
      common /laptword/ ldiffb
c---- Sign of direction from la to lb.
      common /laptword/ lsign

c---- A test word.
      common /laptword/ ltest   (64)

c---- ASCII string equivalent of ltest.
      character*8 atest
c---- ASCII string equivalent of ltest.
      dimension atest(64)
c---- ASCII string equivalent of ltest.
      equivalence (atest, ltest)
c---- Floating point equivalent of ltest.
      dimension ftest(64)
c---- Floating point equivalent of ltest.
      equivalence (ftest, ltest)

c---- Index in arrays lword, kbet.
      common /laptword/ n
cbugc***DEBUG begins.
cbug 9901 format (/ 'aptword testing words to see if in the range:')
cbug 9902 format ('    la=   "',a8,'"' / '    lb=   "',a8,'"')
cbug 9903 format ('    la=   ',i20 / '    lb=   ',i20)
cbug 9904 format ('    la=   ',1pe22.14 / '    lb=   ',1pe22.14)
cbug 9905 format (i3,' lword="',a8,'"')
cbug 9906 format (i3,' lword=',i20)
cbug 9907 format (i3,' lword=',1pe22.14)
cbug
cbug      write ( 3, 9901)
cbug      if (mods .le. 0) then
cbug        write ( 3, 9902) la, lb
cbug        write ( 3, 9905) (n, lword(n), n = 1, nwords)
cbug      elseif (mods .eq. 1) then
cbug        write ( 3, 9903) la, lb
cbug        write ( 3, 9906) (n, lword(n), n = 1, nwords)
cbug      else
cbug        write ( 3, 9904) la, lb
cbug        write ( 3, 9907) (n, lword(n), n = 1, nwords)
cbug      endif
cbugc***DEBUG ends.

c.... Initialize local variables.

      lla = la
      llb = lb

c.... Test for input errors.

      nerr = 0

      if (nwords .lt. 1) then
        nerr = 1
        go to 210
      endif

      if ((mods .lt. 0) .or. (mods .gt. 2)) then
        nerr = 2
        go to 210
      endif

c.... Find the direction from la to lb.

c---- Alphanumeric mode.
      if (mods .eq. 0) then

        if (alb .gt. ala) then
          lsign = 1
        else
          lsign = -1
        endif

c---- Integer mode.
      elseif (mods .eq. 1) then

        if (llb .gt. lla) then
          lsign = 1
        else
          lsign = -1
        endif

c---- Floating point mode.
      else

        if (flb .ge. fla) then
          fsign =  1.0
        else
          fsign = -1.0
        endif

c---- Tested mods.
      endif

c.... Set up the indices of the first subset of data.

      n1 = 1
      n2 = min (nwords, 64)

  110 ns = n2 - n1 + 1


c.... Find temporary set of test words.

c---- Loop over subset of words.
      do 120 n = 1, ns

        nn = n + n1 - 1
        ltest(n) = lword(nn)

c---- End of loop over subset of words.
  120 continue

c.... See if each word lword is between la and lb.

c---- Mode is alphanumeric.
      if (mods .eq. 0) then

c---- Word la is greater than lb.
        if (lsign .eq. -1) then

c---- Loop over subset of words.
          do 130 n = 1, ns

            nn = n + n1 - 1

            if ((atest(n) .le. ala) .and. (atest(n) .ge. alb)) then
              kbet(nn) = 1
            else
              kbet(nn) = 0
            endif

c---- End of loop over subset of words.
  130     continue

c---- Word la is not greater than lb.
        else

c---- Loop over subset of words.
          do 140 n = 1, ns

            nn = n + n1 - 1

            if ((atest(n) .ge. ala) .and. (atest(n) .le. alb)) then
              kbet(nn) = 1
            else
              kbet(nn) = 0
            endif

c---- End of loop over subset of words.
  140     continue

c---- Tested order of la, lb.
        endif

c---- Mode is integer.
      elseif (mods .eq. 1) then

c---- Loop over subset of words.
        do 150 n = 1, ns

          nn = n + n1 - 1

          ldiffa = lsign * (ltest(n) - lla)
          ldiffb = lsign * (llb - ltest(n))

          if ((ldiffa .ge. 0) .and. (ldiffb .ge. 0)) then
            kbet(nn) = 1
          else
            kbet(nn) = 0
          endif

c---- End of loop over subset of words.
  150   continue

c---- Mode is floating point.
      else

c---- Loop over subset of words.
        do 160 n = 1, ns

          nn = n + n1 - 1

          fdiffa = fsign * (ftest(n) - fla)
          fdiffb = fsign * (flb - ftest(n))

          if ((fdiffa .ge. 0.0) .and. (fdiffb .ge. 0.0)) then
            kbet(nn) = 1
          else
            kbet(nn) = 0
          endif

c---- End of loop over subset of words.
  160   continue

c---- Tested mode.
      endif

c.... See if all data subsets are done.

c---- Do another subset of data.
      if (n2 .lt. nwords) then
        n1 = n2 + 1
        n2 = min (nwords, n1 + 63)
        go to 110
      endif

  210 continue
cbugc***DEBUG begins.
cbug 9908 format (/ 'aptword results:')
cbug 9909 format (i3,' lword="',a8,'" kbet=',i3)
cbug 9910 format (i3,' lword=',i20,' kbet=',i3)
cbug 9911 format (i3,' lword=',1pe22.14,' kbet=',i3)
cbug
cbug      write ( 3, 9908)
cbug      if (mods .le. 0) then
cbug        write ( 3, 9909) (n, lword(n), kbet(n), n = 1, nwords)
cbug      elseif (mods .eq. 1) then
cbug        write ( 3, 9910) (n, lword(n), kbet(n), n = 1, nwords)
cbug      else
cbug        write ( 3, 9911) (n, lword(n), kbet(n), n = 1, nwords)
cbug      endif
cbugc***DEBUG ends.
      return

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

UCRL-WEB-209832