      subroutine getgls ( ierr, index,
     &                    sic, scc, iounit )
c
c-----------------------------------------------------------------------
c
c    Search the direct access glossary data for the SIC/SCC(ASC) pairs.
c
c    arguement declaration.
c     Inputs:
c       sic   C SIC code
c       scc   C SCC(ASC) code
c     Outputs:
c       ierr   I error flag
c       index  I index of found SIC/SCC in glossary
c       iounit I I/O unit number of glossary file
c
c-----------------------------------------------------------------------
c    LOG:
c-----------------------------------------------------------------------
c
c      11/26/91  --mmj--  original development
c                       -- much taken from the subroutine getact
c                       -- in centems module of EPS version 1.0
c
c-----------------------------------------------------------------------
c    Argument declarations:
c-----------------------------------------------------------------------
c
      character*4  sic
      character*10 scc
      integer*4    ierr
      integer*4    index
      integer*4    iounit
c
c-----------------------------------------------------------------------
c    Include files:
c-----------------------------------------------------------------------
c
      include 'param.inc'
      include 'ctlgls.inc'
c
c-----------------------------------------------------------------------
c    Local variables:
c-----------------------------------------------------------------------
c
c   dumchr  C   dummy character variable
c   I       I   loop variable
c   ig      I   loop variable for number of direct access records
c   inrec   I   number of records stored
c   ir      I   loop variable for number of records stored
c   irecnt  I   direct access record counter
c   j       I   loop variable
c
      character*1 dumchr
      integer*4   i,  inrec, ir, irecnt, j, k
      integer*8   igls
c
c-----------------------------------------------------------------------
c
      ierr = IFAIL
      index = IMISS
      rewind(iounit)
c
c   --- check if SIC/SCC in current array ---
c
      if ( (sic.LT.begsic)  .OR. (sic.GT.endsic) ) goto 25
      if ( (sic.GT.begsic) .AND. (sic.LT.endsic) ) goto 200
c
c   --- sic = beg or ending sic ---
c
      if ( (sic.EQ.begsic) .AND. (scc.LT.begscc) ) goto 25
      if ( (sic.EQ.endsic) .AND. (scc.GT.endscc) ) goto 25
c
c   --- record must already be in storage array ---
c
      goto 200
c
c   --- need to retrieve new glossary record ---
c
   25 continue
c
      igls = 0
      do 100 while(igls.LE.nglrec)
         igls = igls +1
c
         if ( sic .LT. bstsic(igls) ) goto 500
         if ( sic .GT. estsic(igls) ) goto 100
         if ( (sic .GT. bstsic(igls)) .AND.
     &               (sic .LT. estsic(igls)) ) goto 150
c
c   --- sic = beg or ending SIC ---
c
         if ( (sic .EQ. bstsic(igls)) .AND.
     &              (scc .LT. bstscc(igls)) ) goto 500
         if ( (sic .EQ. estsic(igls)) .AND.
     &              (scc .GT. estscc(igls)) ) goto 100
c
c   --- must be the one ---
c
         goto 150
c
  100 continue
      goto 500
c
c   --- retrieve new glossary block ---
c
  150 continue
      irecnt = igls
      read(iounit,fmtdac,rec=irecnt,ERR=7000)
     &            begsic, begscc, endsic, endscc, inrec,
     &            (savsic(j), savscc(j), (savcod(i,j), i=1,MXCODE),
     &                                                 j=1,MXGREC),
     &            (dumchr,i=1,MXBLNK)
c
c   --- find SIC/SCC index in current retrieved record ---
c
  200 continue
      do 250 ir = 1, inrec
         if ( (sic.EQ.savsic(ir)) .AND. (scc.EQ.savscc(ir)) )  then
            index = ir
            ierr = ISUCES
            goto 9999
         endif
  250 continue
c
c   --- can't find SIC/SCC entry ---
c
  500 continue
      doonce=.FALSE.
      write(IOWSTD,9002,ERR=9999)
     &                  'WARNING: SIC( ', sic, ')/SCC-ASC( ', scc,
     &                            ') pair not found in glossary.'
      ierr = ISUCES
      goto 9999
c
c-----------------------------------------------------------------------
c   Error messages:
c-----------------------------------------------------------------------
c
 7000 continue
      write(IOWSTD,9001,ERR=9999) 'ERROR: Reading glossary file ',
     &                                           ' at block ', irecnt
      go to 9999
c
c-----------------------------------------------------------------------
c   Format statements:
c-----------------------------------------------------------------------
c
 9000 format(1X,A,A,A)
 9001 format(1X,A,A,I5)
 9002 format(1X,A,A,A,A,A)
c
c-----------------------------------------------------------------------
c   Return point:
c-----------------------------------------------------------------------
c
 9999 continue
      return
      end
