SUBROUTINE MAIN
      INTEGER LEVEL, DESC, DEPTH, PTR(5), J, I, STATUS, NXTCOL, JUNK, PA
     *T(132)
      INTEGER OPENDR, GETPAT, GDRPRM, LENGTH, MATCH, GETARG, GTFTOK, IMP
     *UT, IMGET
      LOGICAL*1 PPATH(40), FILE(40), BUF(40), OBUF(512)
      INTEGER MEM( 5000)
      LOGICAL*1 CMEM(10000)
      EQUIVALENCE (CMEM(1),MEM(1))
      COMMON/CDSMEM/MEM
      INTEGER SARRAY
      INTEGER IMINIT
      LOGICAL*1 DEFPAT(2)
      DATA DEFPAT(1)/37/,DEFPAT(2)/0/
      CALL QUERY(21Husage:  fd [path] ...)
      LEVEL = 0
      CALL INPACK(NXTCOL, 80, OBUF, 2)
23000 CONTINUE
      LEVEL = LEVEL + 1
      STATUS = GETARG(LEVEL, PPATH, 40)
      IF (.NOT.(STATUS .EQ. -1 .AND. LEVEL .GT. 1))GOTO 23003
      GOTO 23002
23003 CONTINUE
      IF (.NOT.(STATUS .EQ. -1))GOTO 23005
      CALL GWDIR(PPATH, 5)
23005 CONTINUE
23004 CONTINUE
      SARRAY = IMINIT(5000, 12)
      IF (.NOT.(SARRAY .EQ. 0))GOTO 23007
      CALL ERROR(34HError initializing in-memory sort.)
23007 CONTINUE
      CALL STRCPY(DEFPAT, FILE)
      IF (.NOT.(OPENDR(PPATH, DESC) .EQ. -3))GOTO 23009
      CALL STRCPY(PPATH, BUF)
      CALL MKPATH(BUF, PPATH)
      CALL EXPPTH(PPATH, DEPTH, PTR, BUF)
      J = PTR(DEPTH)
      JUNK = GTFTOK(PPATH, J, FILE)
      J = PTR(DEPTH)
      PPATH(J) = 0
      IF (.NOT.(OPENDR(PPATH, DESC) .EQ. -3))GOTO 23011
      CALL CANT(PPATH)
23011 CONTINUE
23009 CONTINUE
      CALL FOLD(FILE)
      IF (.NOT.(GETPAT(FILE, PAT) .EQ. -3))GOTO 23013
      CALL ERROR(16HIllegal pattern.)
23013 CONTINUE
23015 IF (.NOT.(GDRPRM(DESC, FILE) .NE. -1))GOTO 23016
      I = LENGTH(FILE) + 1
      FILE(I) = 10
      FILE(I+1) = 0
      CALL FOLD(FILE)
      IF (.NOT.(MATCH(FILE, PAT) .EQ. 1))GOTO 23017
      FILE(I) = 0
      IF (.NOT.(IMPUT(SARRAY, FILE) .EQ. -3))GOTO 23019
      CALL REMARK(34HToo many files for in-memory sort.)
      GOTO 23016
23019 CONTINUE
23017 CONTINUE
      GOTO 23015
23016 CONTINUE
      CALL CLOSDR(DESC)
      CALL IMSORT(SARRAY)
23021 IF (.NOT.(IMGET(SARRAY, FILE) .NE. -1))GOTO 23022
      CALL DOPACK(FILE, NXTCOL, 80, OBUF, 2)
      GOTO 23021
23022 CONTINUE
      CALL FLPACK(NXTCOL, 80, OBUF, 2)
23001 GOTO 23000
23002 CONTINUE
      RETURN
      END