#
#	THIS SORT PERFORMS ITS FUNCTION BY ACCEPTING AS MANY RECORDS AS
#	WILL FIT IN ITS WORK AREA AND SORTING THEM IN MEMORY. THESE RECORDS
#	ARE WRITTEN AS A SORTED "RUN" TO A SCRATCH FILE, AND A NEW GROUP
#	OF RECORDS IS ACCUMULATED IN MEMORY. WHEN ALL THE RECORDS HAVE BEEN
#	INTERNALLY SORTED AND WRITTEN AS RUNS TO THE SCRATCH FILES, THE RUNS
#	ARE MERGED TOGETHER INTO ONE STREAM OF SORTED RECORDS. AN ASSEMBLY
#	ROUTINE, COMP, IS USED TO COMPARE TWO OR MORE KEYS AND RETURN THE
#	VALUE OF THE LOWEST.
#
#	THE SORTING TECHNIQUES USED HERE ARE TAKEN FROM DONALD KNUTH'S
#	"The Art of Computer Programming. Volume 3 - Sorting and Searching".
#	IN PARTICULAR, THE ALGORITHM FOR SORTING RECORDS INTERNALLY IN MEMORY
#	IS KNUTH'S ALGORITHM L, (LIST INSERTION) DESCRIBED ON PAGE 96.
#	THE ALGORITHM USED FOR EXTERNAL MERGING IS KNUTH'S ALGORITHM D,
#	(POLYPHASE MERGE SORTING) DESCRIBED ON PAGE 270. IN ADDITION, THE
#	TECHNIQUE OF REPLACEMENT SELECTION AS GENERALLY DESCRIBED ON PAGE 254
#	IS USED TO INCREASE THE AVERAGE RUN LENGTHS OF THE INITIAL MERGE PASS.
#
#	WARNING!!!   NO ATTEMPT SHOULD BE MADE TO UNDERSTAND THIS CODE 
#	             WITHOUT UNDERSTANDING THESE ALGORITHMS.
#
#	AUTHOR:	GLEN HOFFING
#	DATE:	19-MAY-81
#

#
#	DURING THE INPUT PHASE OF THE SORT, THE MEMORY WORK AREA LOOKS
#	AS FOLLOWS. THE MAXIMUM NUMBER OF RECORDS THAT WILL FIT INTO
#	IT IS CALCULATED. THAT NUMBER OF POSITIONS AT THE BEGINNING OF WORK
#	ARE SET ASIDE AS POINTERS TO THE RECORDS WITHIN WORK. EACH RECORD
#	IS FOLLOWED BY A ONE WORD LINK POINTER, WHICH WILL BE USED TO SORT
#	(ORDER) THE RECORDS WITHIN WORK. THUS, A 100 WORD WORK AREA WITH
#	20 WORD RECORDS WOULD INITIALLY LOOK AS FOLLOWS:
#
#		-----------------
#	 1	|       5       |
#		-----------------
#	 2	|      26       |
#		-----------------
#	 3	|      47       |
#		-----------------
#	 4	|      68       |
#		-----------------
#	 5	|               |
#		|   RECORD #1   |
#		|               |
#		-----------------
#	25	| link pointer  |
#		-----------------
#	26	|               |
#		|   RECORD #2   |
#		|               |
#		-----------------
#	46	| link pointer  |
#		-----------------
#	47	|               |
#		|   RECORD #3   |
#		|               |
#		-----------------
#	68	| link pointer  |
#		-----------------
#	69	|               |
#		|   RECORD #4   |
#		|               |
#		-----------------
#	88	| link pointer  |
#		-----------------
#	89	|               |
#		|    unused     |
#      100	|               |
#		-----------------
#
#
#	WHEN THE RECORDS ARE SORTED INTERNALLY, A DUMMY POINTER (LINK0)
#	POINTS TO THE FIRST RECORD. THE FIRST RECORD'S LINK POINTER
#	POINTS TO THE NEXT RECORD, WHOSE LINK POINTER POINTS TO THE NEXT
#	RECORD, AND SO ON UNTIL THE LAST RECORD, WHOSE LINK POINTER IS ZERO.
#	THUS, IN THE EXAMPLE ABOVE, IF THE FOUR RECORDS SHOWN WERE ORDERED
#	RECORD #2, RECORD #4, RECORD #3, AND RECORD #1, THE FOLLOWING
#	VARIABLES WOULD BE SET: 
#
#	LINK0=26, WORK(46)=68, WORK(88)=47, WORK(67)=5,	WORK(25)=0
#



	SUBROUTINE SORTS
	IMPLICIT INTEGER (A-Z)
	DIMENSION WORK(1),KEY(0:1)
	DIMENSION FIBNUM(8),DRUNS(8),DRUNSX(8),DSKLUN(8),DSKX(8),RECORD(0:1)
	DIMENSION TMPADR(8),CMPADR(8),ACTLUN(8),RECIDX(8),KEYIDX(8)
	DATA CALSEQ /0/
##############################################################################
#	                                                                     #
#	RSORT (INITIALIZE SORT)                                              #
#	                                                                     #
##############################################################################
	ENTRY RSORT(P1,P2,P3,WORK,P4,KEY,P5,P6,STATUS)
	RECSIZ = P1			#SAVE INPUT PARAMETERS
	KEYSIZ = P2
	KEYLOC = P3
	WORKSZ = P4
	IFILES = P5
	FIRLUN = P6			#PERFORM INPUT DATA ERROR CHECKS
	IF (CALSEQ != 0)
	  STATUS = 10			#RSORT CALLED OUT OF ORDER
	ELSE IF (WORKSZ <= (IFILES-1) * RECSIZ * 2)
	  STATUS = 6                    #NOT ENOUGH WORK AREA
	ELSE IF (KEYSIZ <= 0 .OR. KEYSIZ > RECSIZ)
	  STATUS = 12			#KEYSIZ NOT VALID
	ELSE IF (RECSIZ <= 0 .OR. RECSIZ > 256)
	  STATUS = 13			#RECSIZ NOT VALID
	ELSE IF (KEYLOC > RECSIZ-1)
	  STATUS = 14			#KEY LOCATION NOT WITHIN RECORD
	ELSE IF (IFILES < 3)
	  STATUS = 17			#TOO FEW SCRATCH FILES
	ELSE IF (IFILES > 8)
	  STATUS = 20			#TOO MANY SCRATCH FILES
	ELSE [
	  CALSEQ = 1			#RESET CALLING SEQUENCE FLAG
	  STATUS = 0
	  #CALCULATE NUMBER OF RECORDS THAT WILL FIT IN MEMORY WORK AREA.
	  #EACH RECORD REQUIRES TWO EXTRA WORDS (ADDRESS PTR AND LINK PTR)
	  MAXREC = WORKSZ / (RECSIZ + 2)
	  DO I = 1,MAXREC		#INITIALIZE ALL ADDRESS POINTERS
	    WORK(I) = MAXREC + ((I-1) * (RECSIZ+1)) + 1
	  DO I = 1,IFILES-1 [		#INITIALIZE AS PER KNUTH
	    FIBNUM(I) = 1
	    DRUNS(I) = 1
	    DSKLUN(I) = FIRLUN + I - 1
	    ]
	  FIBNUM(IFILES) = 0
	  DRUNS(IFILES) = 0
	  DSKLUN(IFILES) = FIRLUN + IFILES - 1
	  LEVEL = 1
	  LOGLUN = 1
	  PWAY = IFILES - 1
	  EXTERN = 0			#SET TO 1 IF EXTERNAL SORTING REQUIRED
	  ICOUNT = 0			#COUNT OF RECORDS IN INTERNAL MEMORY
	  ]
	RETURN


##############################################################################
#	                                                                     #
#	RELES (RELEASE A RECORD TO THE SORT)                                 #
#	                                                                     #
##############################################################################
	ENTRY RELES(RECORD,WORK,KEY,STATUS)
	IF (CALSEQ != 1 .AND. CALSEQ != 2) [
	  STATUS = 10			#RELES CALLED OUT OF ORDER
	  RETURN
	  ]
	STATUS = 0
	CALSEQ = 2			#RESET CALLING SEQUENCE FLAG
	CALL GETADR(TMP,RECORD)		#CHECK WORD ALIGNMENT OF RECORD
	IF ((TMP / 2) * 2 != TMP) [
	  STATUS = 15			#RECORD NOT ON WORD ADDRESS
	  RETURN
	  ]
#
#	IF WORKING ON OUR FIRST RUN, SIMPLY ADD THE RECORD TO MEMORY
#
	IF (EXTERN == 0) [
	  ICOUNT = ICOUNT + 1		#INCREMENT RECORD IN MEMORY COUNT
	  TMP = WORK(ICOUNT)
	  DO I = 0,RECSIZ-1 		#MOVE RECORD INTO MEMORY WORK AREA
	    WORK(TMP+I) = RECORD(I)
	  ]
#
#	OTHERWISE TEST WHETHER THIS RECORD CAN BE APPENDED TO THE PREVIOUS
#	RUN (IT CAN IF IT IS AT LEAST AS LARGE AS LARGEST RECORD IN PREVIOUS
#	RUN). APPEND IT TO THE PREVIOUS RUN, OR ADD IT TO THE CURRENT RUN.
#
	ELSE IF (EXTERN == 1) [
	  CALL GETADR(TMPADR,KEY,RECORD(KEYLOC)) #COMPARE THIS RECORD KEY TO
	  INDX = 2			#LARGEST KEY IN PREVIOUS RUN
	  CALL COMP(INDX,KEYSIZ,TMPADR)
	  IF (INDX == 1) [		#THIS RECORD KEY IS AT LEAST AS BIG AS
	    ENDRUN = 0			#LAST RECORD KEY IN PREVIOUS RUN
	    WRITE (DSKLUN(LOGLUN)) ENDRUN,(RECORD(J),J=0,RECSIZ-1)
	    DO I = 0,KEYSIZ-1		#SAVE THIS RECORD AS NEW LARGEST
	      KEY(I) = RECORD(I+KEYLOC)	#RECORD IN THE PREVIOUS RUN
	    ]
	  ELSE [			#RECORD TOO SMALL-ADD TO CURRENT RUN
	    ICOUNT = ICOUNT + 1		#INCREMENT RECORD IN MEMORY COUNT
	    TMP = WORK(ICOUNT)
	    DO I = 0,RECSIZ-1 		#MOVE RECORD INTO MEMORY WORK AREA
	      WORK(TMP+I) = RECORD(I)
	    ]
	  ]
#
#	IF INTERNAL MEMORY IS FULL, SORT RECORDS AND 
#	WRITE THEM OUT AS A RUN TO SCRATCH FILE
#
	IF (ICOUNT == MAXREC) [		#MEMORY IS FULL - SORT RECORDS
	  LINK0 = ICOUNT		#CREATE LINKED LIST OF SORTED RECORDS
	  TMP = WORK(ICOUNT)		# (TO UNDERSTAND THIS SORT ALGORITHM -
	  WORK(TMP+RECSIZ) = 0		# - PLEASE SEE KNUTH)
	  DO I = ICOUNT-1,1,-1 [
	    PTR = LINK0
	    QTR = 0
	    TMP = WORK(I)
	    DO J = 0,KEYSIZ-1
	      KEY(J) = WORK(TMP+KEYLOC+J)
	    REPEAT [
	      TMP = WORK(PTR)
	      CALL GETADR(TMPADR,KEY,WORK(TMP+KEYLOC))
	      INDX = 2
	      CALL COMP(INDX,KEYSIZ,TMPADR)
	      IF (INDX == 2) [
	        QTR = PTR
	        PTR = WORK(TMP+RECSIZ)
	        ]
	      ELSE
	        BREAK
	      ]
	    UNTIL (PTR == 0)
	    IF (QTR > 0) [
	      TMP = WORK(QTR)
	      WORK(TMP+RECSIZ) = I
	      ]
	    ELSE
	      LINK0 = I
	    TMP = WORK(I)
	    WORK(TMP+RECSIZ) = PTR
	    ]
#
#	  IF THIS IS FIRST USE OF EXTERNAL STORAGE, OPEN SCRATCH FILES
#
	  IF (EXTERN == 0) [
	    EXTERN = 1				#SET EXTERNAL SORT FLAG
	    DO I = FIRLUN,FIRLUN+IFILES-1	#OPEN SCRATCH FILES
	      OPEN (UNIT=I,FORM='UNFORMATTED',RECORDSIZE=RECSIZ/2+1,
	      RECORDTYPE='FIXED',DISP='DELETE',INITIALSIZE=50,EXTENDSIZE=50)
	    ]
#
#	  IF NOT, WRITE AN END OF RUN RECORD TO TERMINATE PREVIOUS RUN,
#	  AND SHUFFLE LUNS, DUMMY RUNS, ETC. (SEE KNUTH)
#
	  ELSE IF (EXTERN == 1) [
	    ENDRUN = 1				#MARK END OF PREVIOUS RUN
	    WRITE (DSKLUN(LOGLUN)) ENDRUN,(RECORD(J),J=0,RECSIZ-1)
	    DRUNS(LOGLUN) = DRUNS(LOGLUN) - 1
	    IF (DRUNS(LOGLUN) < DRUNS(LOGLUN+1))
	      LOGLUN = LOGLUN + 1		#RESET DUMMY RUNS, LOGICAL
	    ELSE IF (DRUNS(LOGLUN) != 0)	#UNITS, LEVEL, AND/OR
	      LOGLUN = 1			#FIBONACCI NUMBERS.
	    ELSE [				#(SEE KNUTH!!!)
	      LEVEL = LEVEL + 1
	      TMP = FIBNUM(1)
	      DO I = 1,PWAY [
	        DRUNS(I) = TMP + FIBNUM(I+1) - FIBNUM(I)
	        FIBNUM(I) = TMP + FIBNUM(I+1)
	        ]
	      LOGLUN = 1
	      ]
	    ]
#
#	  WRITE THIS RUN TO SCRATCH FILE, SAVE LARGEST RECORD
#	  OF RUN AND ZERO RECORDS-IN-MEMORY COUNT.
#
	  PTR = LINK0
	  ENDRUN = 0
	  DO I = 1,ICOUNT [
	    IREC = WORK(PTR)			#WRITE RUN TO SCRATCH FILE
	    WRITE (DSKLUN(LOGLUN)) ENDRUN,(WORK(IREC+J),J=0,RECSIZ-1)
	    PTR = WORK(IREC+RECSIZ)
	    ]
	  DO I = 0,KEYSIZ-1			#SAVE LARGEST KEY OF RUN
	    KEY(I) = WORK(IREC+I+KEYLOC)	#FOR LATER COMPARES.
	  ICOUNT = 0				#CLEAR MEMORY RECORD COUNT
	  ]
	RETURN


##############################################################################
#	                                                                     #
#	MERGE (MERGE RECORDS PASSED TO SORT)                                 #
#	                                                                     #
##############################################################################
	ENTRY MERGE(WORK,KEY,STATUS)
	IF (CALSEQ != 2) [
	  STATUS = 10			#MERGE CALLED OUT OF ORDER
	  RETURN
	  ]
	STATUS = 0
	CALSEQ = 3			#RESET CALLING SEQUENCE FLAG
#
#	IF THERE ARE RECORDS REMAINING IN MEMORY WORK AREA, SORT THEM.
#	(USE SAME ALGORITHM AS IN SUBROUTINE RELES)
#
	IF (ICOUNT > 0) [
	  LINK0 = ICOUNT
	  TMP = WORK(ICOUNT)
	  WORK(TMP+RECSIZ) = 0
	  IF (ICOUNT > 1) [
	    DO I = ICOUNT-1,1,-1 [
	      PTR = LINK0
	      QTR = 0
	      TMP = WORK(I)
	      DO J = 0,KEYSIZ-1
	        KEY(J) = WORK(TMP+KEYLOC+J)
	      REPEAT [
	        TMP = WORK(PTR)
	        CALL GETADR(TMPADR,KEY,WORK(TMP+KEYLOC))
	        INDX = 2
	        CALL COMP(INDX,KEYSIZ,TMPADR)
	        IF (INDX == 2) [
	          QTR = PTR
	          PTR = WORK(TMP+RECSIZ)
	          ]
	        ELSE
	          BREAK
	        ]
	      UNTIL (PTR == 0)
	      IF (QTR > 0) [
	        TMP = WORK(QTR)
	        WORK(TMP+RECSIZ) = I
	        ]
	      ELSE
	        LINK0 = I
	      TMP = WORK(I)
	      WORK(TMP+RECSIZ) = PTR
	      ]
	    ]
	  PTR = LINK0
	  ]
#
#	IF RUNS WERE WRITTEN TO SCRATCH FILE, WRITE END-OF-RUN FOR PREVIOUS
#	RUN, AND IF ANY DATA REMAINS IN MEMORY WRITE IT AS ONE LAST RUN TO
#	DISK. MERGE DISK RUNS USING KNUTH POLYPHASE P-WAY MERGE TECHNIQUE.
#
	IF (EXTERN == 1) [
	  ENDRUN = 1				#WRITE END OF RUN RECORD
	  WRITE (DSKLUN(LOGLUN)) ENDRUN,(WORK(K),K=1,RECSIZ)
	  DRUNS(LOGLUN) = DRUNS(LOGLUN) - 1	#ONE LESS DUMMY RUN
	  IF (ICOUNT > 0) [			#DATA STILL IN MEMORY
	    IF (DRUNS(LOGLUN) < DRUNS(LOGLUN+1))
	      LOGLUN = LOGLUN + 1		#RESET DUMMY RUNS, LOGICAL
	    ELSE IF (DRUNS(LOGLUN) != 0)	#UNITS, LEVEL, AND/OR
	      LOGLUN = 1			#FIBONACCI NUMBERS.
	    ELSE [				#(SEE KNUTH!!!)
	      LEVEL = LEVEL + 1
	      TMP = FIBNUM(1)
	      DO I = 1,PWAY [
	        DRUNS(I) = TMP + FIBNUM(I+1) - FIBNUM(I)
	        FIBNUM(I) = TMP + FIBNUM(I+1)
	        ]
	      LOGLUN = 1
	      ]
	    ENDRUN = 0
	    DO J = 1,ICOUNT [			#WRITE RUN TO DISK
	      TMP = WORK(PTR)
	      WRITE (DSKLUN(LOGLUN)) ENDRUN,(WORK(TMP+K),K=0,RECSIZ-1)
	      PTR = WORK(TMP+RECSIZ)
	      ]
	    ENDRUN = 1				#WRITE END OF RUN RECORD
	    WRITE (DSKLUN(LOGLUN)) ENDRUN,(WORK(K),K=1,RECSIZ)
	    DRUNS(LOGLUN) = DRUNS(LOGLUN) - 1	#ONE LESS DUMMY RUN
	    ]
	  DO I = FIRLUN,FIRLUN+IFILES-1		#REWIND ALL SCRATCH FILES
	    REWIND I
	  #
	  # WORK AREA CAN NOW BE USED TO HOLD RECORDS FROM EACH SCRATCH FILE.
	  # FOR EACH SCRATCH FILE, CALCULATE INDEX INTO WORK FOR RECORD KEY
	  # AND INDEX KEY (KEYIDX IS THE INDEX OF THE KEY OF THE CURRENT 
	  # RECORD JUST READ FROM THE SCRATCH FILE)
	  #
	  DO I = 1,PWAY [
	    RECIDX(I) = RECSIZ * (I-1) + 1
	    KEYIDX(I) = RECIDX(I) + KEYLOC
	    ]
	  REPEAT [
	    TMP = 0
	    DO I = 1,PWAY
	      IF (DRUNS(I) == 0)
	        TMP = 1
	    #
	    # IF ALL SCRATCH FILES AT THIS LEVEL CONTAIN DUMMY RUNS,
	    # DECREMENT ALL DUMMY RUN COUNTS AND TRY AGAIN.
	    #
	    IF (TMP == 0) [
	      DRUNS(IFILES) = DRUNS(IFILES) + 1
	      DO I = 1,PWAY
	        DRUNS(I) = DRUNS(I) - 1
	      ]
	    #
	    # OTHERWISE MERGE ALL SCRATCH FILES NOT CONTAINING DUMMY RUNS.
	    #
	    ELSE [
	      EMPTY = 0
	      REPEAT [
	        #
	        # ACTCNT IS THE COUNT OF AND ACTLUN THE ARRAY CONTAINING THE
	        # LUNS OF ALL FILES TO BE MERGED (NOT CONTAINING DUMMY RUNS)
	        #
	        ACTCNT = 0
	        DO I = 1,PWAY [
	          IF (DRUNS(I) == 0) [
	            ACTCNT = ACTCNT + 1
	            ACTLUN(ACTCNT) = DSKLUN(I)
	            ]
	          ELSE			#DECREMENT DUMMY RUN COUNT OF OTHERS
	            DRUNS(I) = DRUNS(I) - 1
	          ]
	        # GET THE ADDRESS OF ALL KEYS FOR CALL TO COMP
	        CALL GETADR(CMPADR,WORK(KEYIDX(1)),WORK(KEYIDX(2)),
	        WORK(KEYIDX(3)),WORK(KEYIDX(4)),WORK(KEYIDX(5)),
	        WORK(KEYIDX(6)),WORK(KEYIDX(7)))
	        CURCNT = ACTCNT
	        DO I = ACTCNT,1,-1 [
	          #
	          # READ INITIAL RECORD FROM EACH SCRATCH FILE.
	          #
	          READ (ACTLUN(I),END=99) ENDRUN,(WORK(RECIDX(I)+J),
	          J=0,RECSIZ-1)
	          IF (ENDRUN == 1) [
	            IF (.FALSE.) [
  99	              IF (ACTLUN(I) == DSKLUN(PWAY)) [ #IF EMPTY FILE IS PWAY 
	                EMPTY = 1		#SET EMPTY FLAG (SEE KNUTH)
	                CURCNT = 0		#FORCE TEST FOR NEXT LEVEL
	                BREAK
	                ]
	              ]
	            CMPADR(I) = -1		#TELLS COMP TO IGNORE THIS KEY
	            CURCNT = CURCNT - 1		#ONE LESS FILE CONTAINS DATA
	            ]
	          ]
	        IF (CURCNT > 0) [		#IF ANY ACTIVE FILES...
	          REPEAT [
	            #
	            # COMPARE KEYS FROM ALL ACTIVE FILES. WRITE LOWEST ONE
	            # TO SCRATCH FILE AND READ A REPLACEMENT
	            #
	            INDX = ACTCNT
	            CALL COMP(INDX,KEYSIZ,CMPADR)
	            ENDRUN = 0
	            WRITE (DSKLUN(IFILES)) ENDRUN,(WORK(RECIDX(INDX)+J),
	            J=0,RECSIZ-1)		#WRITE RECORD TO SCRATCH FILE
	            READ (ACTLUN(INDX),END=999) ENDRUN,(WORK(RECIDX(INDX)+J),
	            J=0,RECSIZ-1)		#READ A REPLACEMENT RECORD
	            IF (ENDRUN == 1) [		#IF THIS IS THE END OF RUN,
	              IF (.FALSE.) [
 999	                IF (ACTLUN(INDX) == DSKLUN(PWAY))
	                  EMPTY = 1
	                ]
	              CURCNT = CURCNT - 1	#QUIT PROCESSING THIS FILE
	              CMPADR(INDX) = -1
	              ]
	            ]
	          UNTIL (CURCNT == 0)		#CONTINUE UNTIL ALL FILES ARE
	          ENDRUN = 1			#AT END OF RUN OR END OF FILE
	          WRITE (DSKLUN(IFILES)) ENDRUN,(WORK(J),J=1,RECSIZ)
	          ]				#WRITE END OF RUN RECORD
	        ]
	      UNTIL (EMPTY == 1 .AND. DRUNS(PWAY) == 0)	#SEE KNUTH
	      LEVEL = LEVEL - 1			#DECREMENT MERGE LEVEL
	      REWIND DSKLUN(PWAY)		#REWIND FILES
	      REWIND DSKLUN(IFILES)
	      DO I = 2,IFILES [			#ROTATE LUN ASSIGNMENTS
	        DSKX(I) = DSKLUN(I-1)		#(SEE KNUTH)
	        DRUNSX(I) = DRUNS(I-1)
	        ]
	      DSKLUN(1) = DSKLUN(IFILES)
	      DRUNS(1) = DRUNS(IFILES)
	      DO I = 2,IFILES [
	        DSKLUN(I) = DSKX(I)
	        DRUNS(I) = DRUNSX(I)
	        ]
	      ]
	    ]
	  UNTIL (LEVEL == 0)			#AT LAST, WE ARE DONE
	  PTR = LINK0
	  REWIND DSKLUN(1)			#THIS FILE CONTAINS ENTIRE
	  ]					#SORTED RECORD STREAM
	RETURN


##############################################################################
#	                                                                     #
#	RETRN (RETURN A SORTED RECORD)                                       #
#	                                                                     #
##############################################################################
	ENTRY RETRN(RECORD,WORK,KEY,STATUS)
	IF (CALSEQ != 3 .AND. CALSEQ != 4) [
	  STATUS = 10			#RETRN CALLED OUT OF ORDER
	  RETURN
	  ]
	CALL GETADR(TMP,RECORD)
	IF ((TMP / 2) * 2 != TMP) [
	  STATUS = 15			#RECORD NOT WORD ALIGNED
	  RETURN
	  ]
	CALSEQ = 4			#RESET CALLING SEQUENCE FLAG
	STATUS = 0
	IF (EXTERN == 0) [		#ENTIRE SORT PERFORMED IN MEMORY, SO -
	  IF (PTR == 0)			# - RETRIEVE DATA FROM WORK AREA
	    STATUS = -1			#NULL POINTER = END OF DATA
	  ELSE [
	    TMP = WORK(PTR)
	    DO I = 0,RECSIZ-1
	      RECORD(I) = WORK(TMP+I)
	    PTR = WORK(TMP+RECSIZ)
	    ]
	  ]				#EXTERNAL SORTING WAS REQUIRED, SO -
	ELSE IF (EXTERN == 1) [		# - RETRIEVE RECORD FROM SCRATCH FILE
	  READ (DSKLUN(1),END=9999) ENDRUN,(RECORD(I),I=0,RECSIZ-1)
	  IF (ENDRUN == 1)		#END OF RUN = END OF DATA
9999	    STATUS = -1			#END OF FILE = END OF DATA
	  ]
	RETURN


##############################################################################
#	                                                                     #
#	ENDS (CLEANUP SORT)                                                  #
#	                                                                     #
##############################################################################
	ENTRY ENDS(STATUS)
	IF (CALSEQ == 0) [
	  STATUS = 10			#CALL OUT OF SEQUENCE
	  RETURN
	  ]
	CALSEQ = 0			#CLEAR CALLING SEQUENCE FLAG
	STATUS = 0
	DO I = FIRLUN,FIRLUN+IFILES-1
	  CLOSE (UNIT=I,DISP='DELETE')	#CLOSE AND DELETE SCRATCH FILES
	RETURN
	END