subroutine exsort (dataop,maxx,list,option,outfil)
c>>   1990-02-07 exsort  w. v. snyder at jpl, 91109, convert to sftran
      external dataop
      integer maxx, list(*), option, outfil
c
c dataop is a user-coded subroutine used to perform all operations on
c     the data.  the operations include acquiring data from outside of
c     the exsort interface, manipulating scratch files and performing
c     input and output on scratch files, moving data from one memory
c     area to another, returning sorted data from the exsort interface
c     to the user program, and comparing one datum with another.
c
c     calling sequence for dataop:
c     call dataop (iop,i1,i2,iflag)
c     where all arguments are integers,
c     iop defines the operation to be performed,
c     i1 is usually an index (1-4) of a file upon which to operate,
c     i2 is usually an index (1-maxx) of the data area to use.
c     iflag is a flag to be set by dataop.
c     the values of iop and the corresponding required actions are
c     detailed below.
c
c iop  action
c
c 1   place a datum from the set to be sorted in the record area indexed
c     by i2.  i1 is irrelevant.  set the value of iflag to zero if a
c     datum is available.  set the value of iflag to any non-zero value
c     if the entire data set has been provided by this avenue.
c
c 2   write the datum in the record area indexed by i2 on the intermedi-
c     ate scratch file indexed by i1.  the value of iflag is irrelevant.
c
c 3   place an end-of-string mark (eof, unique datum, etc), to be
c     recognized during performance of operation 4 (below), on the
c     intermediate scratch file indexed by i1.  the values of i2 and
c     iflag are irrelevant.
c
c 4   read a datum from the intermediate scratch file indexed by i1 into
c     the record area indexed by i2.  set the value of iflag to zero if
c     a datum is available.  set the value of iflag to any non-zero
c     value if an end-of-string mark created by operation 3 is detected.
c
c 5   rewind the intermediate scratch file indexed by i1.  the values of
c     i2 and iflag are irrelevant.
c
c 6   if i1 is zero, a datum from the sorted data set is in the record
c     area indexed by i2.  if i1 is non-zero, the entire sorted data set
c     has been provided by this avenue.  the value of iflag is irrele-
c     vant.
c
c 7   move the datum in the record area indexed by i1 to the record area
c     indexed by i2.  the value of iflag is irrelevant.
c
c 8   compare the datum in the record area indexed by i1 to the datum in
c     the record area indexed by i2.  set iflag to some negative value
c     if the datum in the record area indexed by i1 is to be sorted
c     before the datum in the record area indexed by i2;  set the value
c     of iflag to zero if the order of the records is immaterial; set
c     iflag to some positive number if the datum in the record area
c     indexed by i1 is to be sorted after the datum in the record area
c     indexed by i2.
c
c maxx is the number of record areas available.  the in-core sort will
c     use maxx, maxx-1 or maxx-2 record areas, so maxx must be at least
c     4.
c
c list is the array used by insort for pointers.  list must be at least
c     maxx words long.
c
c option specifies the action to take if the data are initially ordered
c     or at worst disordered in blocks of less than maxx, but cannot be
c     entirely sorted in core.  if option is zero and the data are init
c     ially ordered, the value of outfil will be the index of the file
c     containing the ordered data.  if option is zero but the data are
c     not initially ordered, the value of outfil will be zero, and the
c     data will have been passed via dataop (6,i1,i2,iflag).  if option
c     is non-zero, the data will always be passed via dataop (6,...),
c     and the value of outfil will be irrelevant.
c
c     *****     external references     ********************************
c
c insrtx  sorts a block of data in memory.  insrtx is a special entry
c         in insort that allows using dataop instead of insort's usual
c         2-argument compare routine.
c pvec    converts the list produced by insrtx to a permutation vector.
c         this is done to allow a binary search in the sorted data set.
c
c
c     *****     local variables     ************************************
c
      integer npr2
      integer dum, inend, head, i, iflag, in(4), in1, in2, in3, in4, j
      integer kode, l, m, maxdat, maxind, maxstr, minind, minstr, mx1
      integer n, nbs, nstrng(4), out(2), outape, out1, out2, split, top
c
c     *****     executable statements     ******************************
c
c     initialize.
c
      outfil=0
      n=0
      kode=2
      maxdat=maxx-1
      mx1=maxx+1
      nbs=0
      minstr=1
      maxstr=2
      minind=maxx
      maxind=maxx-1
c
c     fill the user's data area and sort it.  if end-of-input does not
c     occur, write the data on a scratch file and do a merge later,
c     if necessary.
c
202     if (.not.(n.lt.maxdat)) go to 205
          n=n+1
          call dataop (1,0,n,inend)
          if (inend .eq. 0) go to 202
        n=n-1
        if (.not.(n.eq.0)) go to 207
          if (.not.(nbs.ne.0)) go to 209
            if (nbs.ne.1) go to 203
c                 one block contained all the data.  emit the data from
c                 memory, instead of reading it from scratch.
            call dataop (5,1,0,dum)
            kode=6
            outape=0
            assign 210 to npr2
c           procedure (output the block)
            go to 302
c
210         continue
209         call dataop (6,1,0,dum)
            return
207       continue
205     call insrtx (dataop,n,list,head)
        nbs=nbs+1
        outape=minstr
        if (.not.(nbs.eq.1)) go to 212
          if (.not.(inend.ne.0)) go to 214
c
          kode=6
          outape=0
          assign 215 to npr2
c         procedure (output the block)
          go to 302
c
215       call dataop (6,1,0,dum)
          return
214       do 216 i=1,4
            call dataop (5,i,0,dum)
            nstrng(i)=0
216         continue
          nstrng(1)=1
          assign 219 to npr2
c         procedure (output the block)
          go to 302
219       go to 211
c
c           another block has been sorted.  see if it will fit on an
c           existing string.
c
212     iflag=-1
        if (nstrng(2).ne.0) call dataop (8,head,maxind,iflag)
        if(iflag.lt.0)then
          call dataop (8,head,minind,iflag)
        else
          outape=maxstr
        endif
        if (.not.(iflag .ge. 0)) go to 223
c              the whole block fits after the last thing written.
          assign 224 to npr2
c         procedure (output the block)
          go to 302
224       go to 222
c
c              the sorted string won't fit on an existing string.  will
c              part of it fit?
c
223     call pvec (list,head)
        call dataop (8,list(n),minind,iflag)
        if(iflag .lt. 0)then
c
c                 none of the list will fit.  handle the list similarly
c                 to the part that won't fit.
c
          top=n
        else
c
c                 some of it will fit.  find out how much.
c
          i=1
          j=n
227       if(j-i.gt.1)then
             split=(j+i)/2
             call dataop (8,list(split),minind,iflag)
             if(iflag .ge. 0)then
               j=split
             else
               i=split
             endif
             go to 227
           endif
           split=j
c
c            write the part that will fit on intermediate scratch.
c
           do 231 j=split,n
             call dataop (2,minstr,list(j),dum)
231          continue
           call dataop (7,list(n),minind,dum)
           top=split-1
        endif
        if(nstrng(2).ne.0)then
c
c                 determine which intermediate scratch file to use for
c                 the part that won't fit.  the rule is to use the file
c                 with the least strings.  if the number of strings is
c                 the same, use the file with the maximum final datum.
c
          if(nstrng(1).ne.nstrng(2))then
            if (nstrng(outape).ge.nstrng(3-outape)) outape=3-outape
          else
            outape=maxstr
          endif
          call dataop (3,outape,0,dum)
        else
c
c                 if we are writing the first string on file 2, we must
c                 decrease the available space for sorting.
c
          outape=2
          maxdat=maxdat-1
        endif
        nstrng(outape)=nstrng(outape)+1
c
c              write the part that won't fit on intermediate scratch.
c
        do 238 j=1,top
          call dataop (2,outape,list(j),dum)
238       continue
        top=list(top)
c
c              the sorted block has been written on intermediate
c              scratch.c
222     continue
c        test end to see if we need to sort more.
211     if (inend .ne. 0) go to 203
        call dataop (7,top,mx1-outape,dum)
        n=0
        if (.not.(nstrng(2).ne.0)) go to 241
c         determine minstr etc.
          call dataop (8,minind,maxind,iflag)
          if(iflag .ge. 0)then
            i=maxstr
            maxstr=minstr
            minstr=i
            i=maxind
            maxind=minind
            minind=i
          endif
241     go to 202
c
c     all of the data have been block-sorted.  determine whether we
c     need to do a merge.
c
203   call dataop (3,1,0,dum)
      call dataop (5,1,0,dum)
      if(nstrng(2).eq.0)then
c
c        all of the data are on scratch 1.
c        see what the user wants to do.
c
        if(option.eq.0)then
          outfil=1
          return
        endif
246     call dataop (4,1,1,iflag)
        if (iflag .ne. 0) go to 247
          call dataop (6,0,1,dum)
          go to 246
247     call dataop (5,1,0,dum)
      else
c
c        we must do a merge.  set some values, and then check what
c        kind of output we do for this pass.
c
        call dataop (3,2,0,dum)
        call dataop (5,2,0,dum)
        in(1)=1
c        in(1) is to be the file with the most strings.
        if (nstrng(1).lt.nstrng(2)) in(1)=2
        in(2)=3-in(1)
        out(1)=3
        out(2)=4
        m=2
248     if(nstrng(in(1)).ne.1)then
          i=in(1)
          in(1)=in(2)
          in(2)=i
        else
          kode=6
          out(1)=0
        endif
        outape=1
c
c           read one record from each file to start the merge.  sort
c           these records.  then do the merge by writing the lowest
c           record, reading a new record from the lowest file and
c           re-ordering the records with a partial in-core merge.
c
252     call dataop (4,in(1),1,iflag)
        call dataop (4,in(2),2,iflag)
        if(m .ne. 2)then
          call dataop (4,in(3),3,iflag)
          if (m .eq. 4) call dataop (4,in(4),4,iflag)
        endif
c              sort set of first records from each file
        call insrtx (dataop,m,list,head)
c
c              write current lowest record,and then read a new record
c              from the same file.
c
256       call dataop (kode,out(outape),head,dum)
          call dataop (4,in(head),head,inend)
          i=list(head)
          if(inend .eq. 0)then
            if(i.ne.0)then
c                    if i=0, head is only remaining file
              call dataop (8,head,i,iflag)
              if(iflag .gt. 0)then
c
c                          head is no longer lowest.  merge it with
c                          chain.
c
                l=head
                head=i
264               j=list(i)
                  if (j.eq.0) go to 265
                  call dataop (8,l,j,iflag)
                  if (iflag .le. 0) go to 265
                  i=j
                  go to 264
265             list(i)=l
                list(l)=j
              endif
            endif
          else
c
c                    a string has terminated.
c
            l=in(head)
            nstrng(l)=nstrng(l)-1
            if (nstrng(l).eq.0) call dataop (5,l,0,dum)
            if (i.eq.0) go to 257
            head=i
          endif
          go to 256
c
c              all strings have terminated.  if we are doing final
c              output we are done.
c
257   if (kode.eq.6) go to 249
c
c              determine whether to continue the current merge pass or
c              start a new one.
c
        l=out(outape)
        nstrng(l)=nstrng(l)+1
        call dataop (3,l,0,dum)
        j=nstrng(in(1))+nstrng(in(2))
        if(j.eq.2)then
          if(nstrng(out(1)).eq.1)then
c
c                    the total remaining input string count is 2.  the
c                    total output string count is 1 or 2.  we will do
c                    final output with a merge order of 3 or 4
c                    depending on whether the total output string count
c                    is 1 or 2.
c
            in(3)=out(1)
            m=4
            call dataop (5,out(1),0,dum)
            if(nstrng(out(2)).ne.0)then
              m=5
              in(4)=out(2)
              call dataop (5,out(2),0,dum)
            endif
            kode=6
            out(1)=0
            outape=2
          endif
        else if(nstrng(in(1)).eq.0) then
          go to 253
        endif
        outape=3-outape
        m=max(m-1,2)
        go to 252
c
c           we must start a new merge pass.  swap input and output
c           files.  if the total remaining input string count is 1,
c           the merge order can be temporarily raised to 3.
c
253     m=2
c           nstrng(in(2)) is always .ge. nstrng(in(1)).
        call dataop (5,out(1),0,dum)
        if(nstrng(out(2)).ne.0)then
          if(nstrng(in(2)).ne.0)then
            m=3
            in(3)=in(2)
          endif
          call dataop (5,out(2),0,dum)
          i=in(2)
          in(2)=out(2)
          out(2)=i
        endif
        i=in(1)
        in(1)=out(1)
        out(1)=i
        go to 248
249     continue
      endif
c
      call dataop (6,1,0,dum)
      return
c
c
c
c
c     procedure (output the block)
302   m=head
279   if(m.ne.0)then
         call dataop (kode,outape,m,iflag)
         top=m
         m=list(top)
         go to 279
      endif
      go to npr2,(210,215,219,224)
c
      end