Trailing-Edge
-
PDP-10 Archives
-
decuslib10-01
-
43,50212/pull3.f4
There are no other files named pull3.f4 in the archive.
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