SUBROUTINE RLSORT(NDP,IPACK1,ISORT,IPACK2,IESTB,ISTORE,NK,IFA,IP,
     1LOCR,MODE)
C*****NDP- NUMBER OF DISK PACKS WHICH CONTAIN FILES TO BE WORKED ON
C*****IPACK1- NAME OF DISK PACK WHICH CONTAINS THE FILE TO BE SORTED
C*****ISORT- NAME OF THE FILE TO BE SORTED
C*****IPACK2- NAME OF THE DISK PACK TO BE USED IN SORTING THE FILE
C*****IESTB- NAME OF THE FILE TO BE ESTABLISHED  TO USE IN SORTING
C*****ISTORE- NAME OF THE FILE WHICH IS TO CONTAIN THE FINAL SORTED LIST
C*****NOTE THAT ISTORE MUST BE EITHER ISORT OR IESTB
C*****NK- WHAT WORD IN THE SECTOR THE DISTRIBUTION WILL BE ON
C******IFA - NUMBER OF LOGICAL CHARACTERS TO SORT ON
C*****MODE =2 IF TWO DIGITS  AT A TIME =1 IF ONE DIGIT,=3 IF ALPHA CHAR
C*****IP - LETTER OR DIGIT IN THE WORD FROM LEFT TO RIGHT
C*****LOCR - SECTOR NUMBER WITHIN A RECORD IN IDI WHERE THE FIRST WORD
C*****OF THE KEY IS LOCATED
      DIMENSION JPAR(10),IB(50),B(50),IPAR(10),IFRMT(3,19),ITABLE(128)
	COMMON IDF,LFR,NAVR,MAXR,NSPR,LSR,LFMT,NCPR,LPFR,C1
	COMMON IFRMAT
      EQUIVALENCE (IPAR(1),IDF)
      NPASS=IFA
	KOUNT=IP
	NSRCH=NDP
C*****CHECK TO SEE WE HAVE ON CORRECT DISK PACK AND SET NMOD1=1 IF IT IS
C*****LEFT PACK AND =2 IF IT IS RIGHT
83	CALL SLCTF(-(NSRCH-1),IPACK1)
	NMOD1=IUNPAK(3,6,LPFR)
C*****FIND THE FILE TO BE SORTED AND CALCULATE THE PARAMETERS TO BE USED
C*****IN DFNF
89    CALL SLCTF(NMOD1,ISORT)
	NSORT=ISORT
      NREC=(NAVR-LFR)/NSPR
      NSPR1=NSPR
      NCPR1=0
C*****CHECK FOR CORRECT DISK PACK AS ABOVE
      CALL SLCTF(-(NSRCH-1),IPACK2)
	NMOD2=IUNPAK(3,6,LPFR)
C*****DEFINE THE FILE TO BE USED IN SORTING
88    CALL DFNF(IESTB,NSPR1,NREC,NCPR1,NMOD2)
	NTEMP=IESTB
C*****BEGIN ROUTINE WHICH CALLS DISTR3 AND PULL3 WITH CORRECT PARAM
C*****PUT IN COMMON THE POINTER FILE OF THE FILE TO BE SORTED
C		TEST IF FILE EMPTY
	IF(NREC.LE.0)RETURN
1	CALL SLCTF(NMOD1,NSORT)
      NSPK=1
      CALL DISTR3(NK,  MODE,KOUNT,ITABLE,LOCR,NSPK,IB)
      CALL PULL3(NK,  MODE,KOUNT,ITABLE,LOCR,NMOD2,NTEMP,IB)
      KOUNT=KOUNT+1
      NPASS=NPASS-1
      IF (NPASS) 75,75,70
70	NTEMP=NSORT
	NSORT=IDF
	NMOD2=NMOD1
	NMOD1=IUNPAK(3,6,LFR)
      GO TO 1
C*****CHECK TO SEE THAT THE FILE IS LEFT IN FILE ISTORE  IF IT IS NOT
C*****COPY IT INTO ISTORE
75    IF (ISTORE-IDF) 41,40,41
41    NR=(NAVR-LFR)/NSPR
      LFR1=LFR
	CALL SLCTF(NMOD1,NSORT)
      LSI=LFR1
      LSO=LFR
      DO 10 II=1,NR
      CALL DIO(LSI,1,IB,NSPR)
      CALL DIO(LSO,0,IB,NSPR)
      LSI=LSI+NSPR
10    LSO=LSO+NSPR
40    RETURN
	CALL SAVEF
      END
      SUBROUTINE DISTR3(NK,IFA,IP,ITABLE,LOCR,NSPK,IB)
C*****THIS SUBROUTINE SETS UP THE DISTRIBUTION TABLE WHICH WILL BE USED
C*****IN PREDICTING ADDRESSES ******************************************
C*****IT CALCULATES THE DISTRIBUTION FOR WHATEVER FILE IS IN COMMON
C*****NK- WHAT WORD IN THE RECORD THE DISTRIBUTION WILL BE ON
C*****IFA =2 IF TWO DIGITS  AT A TIME =1 IF ONE DIGIT, =3 IF 1 ALPHA CHARACTER
C*****IP - LETTER OR DIGIT IN THE WORD FROM LEFT TO RIGHT
C*****ITABLE WILL HOLD THE DISTRIBUTION TABLE
C*****LOCR - SECTOR NUMBER WITHIN A RECORD IN IDI WHERE THE FIRST WORD
C*****OF THE KEY IS LOCATED
C*****NSPK - NUMBER OF SECTORS WHICH HOLD THE KEY
      DIMENSION JPAR(10),IPAR(10),ITABLE(100),IFRMT(1),IB(10)
	COMMON IDF,LFR,NAVR,MAXR,NSPR,LSR,LFMT,NCPR,LPTR,C1
      EQUIVALENCE (IPAR(1),IDF)
C*****CALCULATE THE PARAMETERS FOR IUNPAK
	GO TO(1,2,3)IFA
1	IMP=10
	IFA1=1
	GO TO 4
2	IMP=5
	IFA1=2
	GO TO 4
3	IFA1=2
	IMP=5
4	N1=IFA1*(IMP-IP)
	N2=IFA1*(IP-1)
C*****INITIALIZE THE DISTRIBUTION TABLE TO ZERO
	DO 45 I=1,128
45    ITABLE(I)=0
C*****LOOP THROUGH ALL THE RECORDS IN THE MASTER FILE ******************
      NR=(NAVR-LFR)/NSPR
      ILOC=LFR+LOCR-1
      DO 410 II=1,NR
C*****ILOC POINTS TO SECTOR WHICH CONTAINS THE FIRST WORD OF THE KEY
C*****READ INTO IB THE WORDS OF THE KEY
      CALL DIO(ILOC,1,IB,NSPK)
C*****CALCULATE THE NUMERIC CODE OF THE DESIRED NUMBER OR LETTER
	IF(IFA.EQ.3)GO TO 5
      NCODE=IUNPAK(N1,N2,IB(NK))+1
C*****INCREMENT THE TABLE FOR THAT CODE
6	ITABLE(NCODE)=ITABLE(NCODE)+1
410   ILOC=ILOC+NSPR
C*****FORM THE CUMULATIVE DISTRIBUTION FUNCTION
      DO 425 I=1,127
425   ITABLE(I+1)=ITABLE(I+1)+ITABLE(I)
	RETURN
5	NCODE=JUNPAK(N1/2,N2/2,IB(NK))+1
	GO TO 6
	END
      SUBROUTINE PULL3(NK,IFA,IP,ITABLE,LOCR,NMOD2,NESTB,IB)
C*****SORTS THE FILE WHOSE PARAMETERS ARE IN COMMON ********************
C*****NK- WHAT WORD IN THE RECORD THE DISTRIBUTION WILL BE ON
C*****IFA =2 IF TWO DIGITS OR ONE ALPHA AT A TIME =1 IF ONE DIGIT
C*****IP - LETTER OR DIGIT IN THE WORD FROM LEFT TO RIGHT
C*****ITABLE WILL HOLD THE DISTRIBUTION TABLE
C*****LOCR - SECTOR NUMBER WITHIN A RECORD IN IDI WHERE THE FIRST WORD
C*****OF THE KEY IS LOCATED
C*****LPFRT - THE LOCATION OF THE POINTER FILE FOR THE FILE WHICH IS
C*****TO HOLD THE SORTED RECORDS
      DIMENSION IPAR(10),JPAR(10),IFRMT(1),IB(10),ITABLE(100)
	COMMON IDF,LFR,NAVR,MAXR,NSPR,LSR,LFMT,NCPR,LPTR,C1
      EQUIVALENCE (IPAR(1),IDF)
      NSPK=1
      IZERO=0
C*****CALCULATE PARAMETERS FOR IUNPAK
	GO TO (1,2,3)IFA
1	IMP=10
	IFA1=1
	GO TO 4
2	IMP=5
	IFA1=2
	GO TO 4
3	IMP=5
	IFA1=2
4	N1=IFA1*(IMP-IP)
	N2=IFA1*(IP-1)
C*****PARAMETERS OF THE FILE TO BE SORTED ARE IN COMMON
      LFR1=LFR
      NSPR1=NSPR
      NR=(NAVR-LFR)/NSPR
C*****PUT PARAMETERS OF FILE TO HOLD SORTED LIST IN COMMON
	CALL SLCTF(NMOD2,NESTB)
C*****LOOP THROUGH ALL THE RECORDS IN THE FILE TO BE SORTED, CALCULATE
C*****WHERE IT GOES IN NEW FILE AND WRITE IT IN NEW FILE
      JLOC=LFR1
      NK1=10*(LOCR-1)+NK
      DO 10 II=1,NR
C*****ILOC IS THE SECTOR IN THE FILE TO BE SORTED THAT THE KEY IS IN
      CALL DIO(JLOC,1,IB,NSPR)
	IF(IFA.EQ.3)GO TO 5
          NLCODE=IUNPAK(N1,N2,IB(NK1))
6	IF(NLCODE)20,30,20
30    IPOS=IZERO
      IZERO=IZERO+1
      GO TO 40
20    IPOS=ITABLE(NLCODE)
      ITABLE(NLCODE)=ITABLE(NLCODE)+1
C*****JLOC REFERS TO THE RECORD IN THE FILE TO BE SORTED
C*****KLOC IS THE PLACE IN THE NEW FILE WHERE THAT RECORD WILL GO
40    KLOC=LFR+IPOS*NSPR
      CALL DIO(KLOC,0,IB,NSPR)
10    JLOC=JLOC+NSPR
C*****PUT THE NEW FILE PARAMETERS IN COMMON
      NAVR=LFR+NR*NSPR
	CALL SAVEF
	RETURN
5	NLCODE=JUNPAK(N1/2,N2/2,IB(NK1))
	GO TO 6
	END