1000 ! RANKER -- RANKS A PARTICULAR CLASS BY CUM GPA ! USING MASTER GPA FILE. BASED ON 'SORTX' PROGRAM. 1020 ! OUTPUT FILE MAY BE DISK OR DECTAPE; IF DEFAULTED ! ONLY INDEX FILE IS WRITTEN. INPUT FILE MUST BE ! IN RECORD I/O AND ON A DISK. 1030 ! NON-CURRENT STUDENTS (INDICATED BY "N" IN COL 123) ! ARE REJECTED FROM THE RANKING. 1040 ! SWITCHES: /C:XX (XX=CLASS YEAR) ! /G:N N=4 FOR 4 PT AND 9 FOR 9 PT 1060 ! 30-MAY-74 J. WARDEN WABASH COLLEGE 1080 T3=TIME(0%) : PRINT"RANKER V01A" 1100 DIM I$(63),O$(63),A$(63),P$(63),A2$(16) 1120 ON ERROR GO TO 1440 : OPEN "KB:" AS FILE 9% 1140 PRINT"#"; : INPUT LINE #9%,F$ : F$=LEFT(F$,LEN(F$)-2%) : IF ASCII(F$)<32% THEN CLOSE 9% : GO TO 5260 1160 F%=INSTR(1%,F$,"<") : IF F% THEN F2$=LEFT(F$,F%-1%) : F$=RIGHT(F$,F%+1%) 1180 F3%=INSTR(1%,"DT0:DT1:",LEFT(F2$,4%)) 1200 F%=INSTR(1%,F$,"/G:") : IF F%=0% THEN 1420 1220 F1%=ASCII(RIGHT(F$,F%+3%))-48% : F$=LEFT(F$,F%-1%) : F%=F1% 1240 IF F%=4% THEN C1%=69% ELSE IF F%=9% THEN C1%=45% ELSE 1420 1260 F%=INSTR(1%,F$,"/C:") : IF F%=0% THEN 1420 1280 J0$=MID(F$,F%+3%,2%) : F$=LEFT(F$,F%-1%) : IF J0$<"73" OR J0$>"80" THEN &"** CLASS YEAR ? **" : GO TO 1140 1290 N%,L1%=4% 1300 N6%=N%-1% : N1%=510%/N% : N2%=N1%-8% 1320 IF INSTR(1%,"DT0:DT1:",LEFT(F$,4%)) THEN PRINT"** DISK SORT ONLY **" : GO TO 1140 1340 IF INSTR(1%,"DK0:DK1:DK2:DK3:",LEFT(F$,4%)) THEN D$=LEFT(F$,4%) 1360 L2%=L1%*C1% : IF L2%=6% THEN E$=".IDC" ELSE IF L2%=14% THEN E$=".CYR" ELSE IF L2%=565% THEN E$=".ZIP" ELSE E$=".KEY" 1380 L2%=L1%+1% 1400 ON ERROR GO TO 2080 : GO TO 1460 1420 PRINT"** RETYPE PLEASE **" : GO TO 1140 1440 RESUME 1420 1460 OPEN F$ FOR INPUT AS FILE 5% 1480 FIELD #5%,N1%*R% AS Z$,N1% AS I$(R%) FOR R%=0% TO N6% 1500 C%=1% : Q1%=0% 1520 P1$= D$+"RANK01.TMP" : GOSUB 4280 1540 IF R%J0$ THEN 1540 1572 C9=CVT$F(MID(I$(R%),C1%,L1%)) 1574 IF C9<0. OR C9>9. THEN &LEFT(I$(R%),6%)+" ";C9 : GO TO 1540 1576 C9%=INT(1000.*C9+.49999) : C9$=NUM$(C9%) 1578 C9$=LEFT("000000",6%-LEN(C9$))+RIGHT(C9$,2%) 1580 LSET P$(P%)=LEFT(C9$,4%)+CVT%$(Q1%) 1600 GOSUB 4600 : C%=C%+1% : GO TO 1540 1620 LSET P$(P1%)="\\\\\\\\" FOR P1%=P% TO 62% 1640 PUT #1% : CLOSE 1% 1660 ! INIT LINK FILE 1680 PRINT CHR$(9%);"RECORDS:";C% 1700 A1$= D$+"RANK01.TMP" : GOSUB 4220 1720 P1$= D$+"RANK02.TMP" : GOSUB 4280 1740 ! - - - - - - - - - - - - - - 1760 PRINT CHR$(9%);"CORE SORT "; 1780 I%=C%/16% : I2%=I%*16% : I3%=C%-I2% 1800 FOR I1%=1% TO I% 1820 C2%=16%*(I1%-1%)+1% : C3%=C2%+15% 1840 GOSUB 4820 1860 NEXT I1% 1880 C2%=C3%+1% : C3%=C2%+I3%-1% 1900 GOSUB 4820 ! SORT TAG END 1920 LSET P$(P1%)="\\\\\\\\" FOR P1%=P% TO 62% 1940 PUT #1% : CLOSE 1%,2% : PRINT"COMPLETED" 2000 IF C%<=16% THEN 3360 ! SKIP MERGE IF 16 REC OR LESS 2020 ! - - - - - - - - - - - - - 2040 GO TO 2120 2060 ! ERRORS COME HERE... 2080 IF ERR=11% THEN RESUME 1620 ELSE IF ERR<>5% THEN ON ERROR GO TO 0 2100 PRINT"** CAN'T FIND FILE '";F$;"' **" : RESUME 1140 2120 ! NOW WE MUST OPEN A MERGE FILE 2140 ON ERROR GO TO 0 2160 P1$= D$+"RANK01.TMP" : GOSUB 4280 2180 A1$= D$+"RANK02.TMP" : GOSUB 4180 2200 ! BEGIN MERGE SEQUENCE 2220 PRINT CHR$(9%);"MERGE:"; 2240 F%=16% 2260 ! RE-INITIALIZE MERGE SEQUENCES HERE 2280 S1%=1% : S2%=1%+F% ! STARTING PLACES 2300 PRINT F%; 2320 ! SHORT MERGES CONTINUE HERE 2340 U1%=S1%+F%-1% : U2%=S2%+F%-1% ! UPPER LIMITS 2360 IF U1%>=C% THEN 2960 2380 IF U2%>C% THEN U2%=C% 2400 H%=S1% : GOSUB 4360 2420 H%=S2% : GOSUB 4440 2440 IF A$(A%)<=O$(O%) THEN 2560 2460 LSET P$(P%)=O$(O%) 2480 S2%=S2%+1% 2500 GOSUB 4600 2520 IF S2%>U2% THEN 2780 2540 GOSUB 4560 : GO TO 2440 2560 LSET P$(P%)=A$(A%) 2580 S1%=S1%+1% 2600 GOSUB 4600 2620 IF S1%>U1% THEN 2660 2640 GOSUB 4520 : GO TO 2440 2660 LSET P$(P%)=O$(O%) 2680 GOSUB 4600 2700 FOR I%=S2%+1% TO U2% 2720 GOSUB 4560 : LSET P$(P%)=O$(O%) : GOSUB 4600 2740 NEXT I% 2760 GO TO 2900 2780 LSET P$(P%)=A$(A%) 2800 GOSUB 4600 2820 FOR I%=S1%+1% TO U1% 2840 GOSUB 4520 : LSET P$(P%)=A$(A%) : GOSUB 4600 2860 NEXT I% 2880 ! FIRST SHORT MERGE COMPLETE 2900 S1%=U2%+1% : S2%=S1%+F% 2920 GO TO 2340 2940 ! WRITE UNMERGED ENTRIES 2960 H%=P9% : GOSUB 4360 2980 Q%=P9% 3000 FOR I%=Q% TO C% 3020 GOSUB 4520 : LSET P$(P%)=A$(A%) : GOSUB 4600 3040 NEXT I% 3060 LSET P$(P1%)="\\\\\\\\" FOR P1%=P% TO 62% 3080 PUT #1%,COUNT 504% 3100 ! COMPLETE PASS THROUGH FILE 3120 CLOSE 1%,2%,3% 3140 F%=F%*2% 3160 IF F%>=C% THEN 3320 3180 IF P1$= D$+"RANK01.TMP" THEN 3260 3200 P1$= D$+"RANK01.TMP" : GOSUB 4280 3220 A1$= D$+"RANK02.TMP" : GOSUB 4180 3240 GO TO 2280 3260 P1$= D$+"RANK02.TMP" : GOSUB 4280 3280 A1$= D$+"RANK01.TMP" : GOSUB 4180 3300 GO TO 2280 3320 ! WE'RE DONE!! 3340 PRINT"DONE" : KILL A1$ 3360 IF LEN(F2$) THEN 3500 3380 R%=INSTR(1%,F$,".") : IF R% THEN F$=LEFT(F$,R%-1%) 3400 ON ERROR GO TO 3480 3420 NAME P1$ AS F$+E$ : PRINT CHR$(9%);"INDEX FILE: ";F$+E$ 3440 F%=(TIME(0%)-T3)/6. : F=F% : & CHR$(9%);"TIME";F/10.;"MINUTES" 3460 GO TO 5260 3480 IF ERR=16% AND ERL=3420% THEN KILL F$+E$ : RESUME 3420 3500 ON ERROR GO TO 0 3520 ! NOW WRITE THE RESULTS 3540 OPEN P1$ FOR INPUT AS FILE 1% 3560 FIELD #1%,8%*A% AS Z$,8% AS A$(A%) FOR A%=0% TO 62% 3580 OPEN F2$ FOR OUTPUT AS FILE 6% 3600 FIELD #6,N1%*S% AS Z$,N1% AS O$(S%) FOR S%=0% TO N6% 3620 S%,S0%=0% : IF F3%=0% AND C%>N% THEN PUT #6%, RECORD C%/N% 3640 FOR I%=1% TO C% 3660 IF A%<62% THEN A%=A%+1% ELSE A%=0% : GET #1% 3680 I2%=CVT$%(MID(A$(A%),L2%,2%)) 3700 R1%=(I2%+N6%)/N% 3720 R%=I2%-1%-(R1%-1%)*N% 3740 GET #5%,RECORD R1% 3760 LSET O$(S%)=LEFT(I$(R%),88%)+CVT%$(C%-I%+1%)+RIGHT(I$(R%),91%) 3780 GOSUB 4680 3800 NEXT I% 3820 GOSUB 4740 3840 KILL P1$ 3860 GO TO 3440 3880 ! OPEN NEW FILE SUBROUTINE 3900 GOSUB 4740 3920 ON ERROR GO TO 4080 3940 INPUT"NEW OUTPUT FILE";F2$ 3960 OPEN F2$ FOR OUTPUT AS FILE 6% 3980 FIELD #6%,N1%*S% AS Z$, N1% AS O$(S%) FOR S%=0% TO N6% 4000 S%,S0%=0% 4020 F3%=INSTR(1%,F2$,"DT0:") 4040 IF F3%=0% THEN F3%=INSTR(1%,F2$,"DT1:") 4060 GO TO 4140 4080 IF ERR=2% THEN PRINT"ILLEGAL FILE NAME - RETYPE!" : RESUME 3940 4100 IF ERR=14% THEN PRINT"DEVICE OK ???" : RESUME 3940 4120 ON ERROR GO TO 0 4140 RETURN 4160 ! - - - I/O SUBROUTINES - - - 4180 OPEN A1$ FOR INPUT AS FILE 3% 4200 FIELD #3%,8%*O% AS Z$,8% AS O$(O%) FOR O%=0% TO 62% 4220 OPEN A1$ FOR INPUT AS FILE 2% 4240 FIELD #2%,8%*A% AS Z$,8% AS A$(A%) FOR A%=0% TO 62% 4260 RETURN 4280 OPEN P1$ FOR OUTPUT AS FILE 1% : IF C%>63% THEN PUT #1%,RECORD C%/63% 4300 FIELD #1%,8%*P% AS Z$, 8% AS P$(P%) FOR P%=0% TO 62% 4320 P%,P9%,P0%=0% 4340 RETURN 4360 R1%=(H%+62%)/63% 4380 A%=H%+62%-R1%*63% 4400 GET #2%,RECORD R1% 4420 RETURN 4440 R2%=(H%+62%)/63% 4460 O%=H%+62%-R2%*63% 4480 GET #3%,RECORD R2% 4500 RETURN 4520 IF A%<62% THEN A%=A%+1% ELSE A%=0% : GET #2% 4540 RETURN 4560 IF O%<62% THEN O%=O%+1% ELSE O%=0% : GET #3% 4580 RETURN 4600 IF P%<62% THEN P%=P%+1% ELSE P%=0% : P0%=P0%+1% : PUT #1%, RECORD P0% 4620 P9%=P9%+1% 4640 RETURN 4660 ! 'PUT' SUBROUTINE 4680 IF S%=530% THEN GOSUB 3880 !(NEW TAPE) 4720 RETURN 4740 ! CLOSE SUBROUTINE 4760 LSET O$(R%)="\\\\\\"+SPACE$(N2%)+CHR$(13%)+CHR$(10%) FOR R%=S% TO N6% : PUT #6% : CLOSE 6% 4780 PRINT CHR$(9%);"SORTED RECORDS:";S0%*N%+S% 4800 RETURN 4820 ! BUBBLE SORT SUBROUTINE 4840 FOR R%=C2% TO C3% 4860 S%=R%-C2% 4880 IF A%<62% THEN A%=A%+1% ELSE A%=0% : GET #2% 4900 A2$(S%)=A$(A%)+"" 4920 NEXT R% 4940 FOR R%=0% TO C3%-C2% 4960 T2%=0% 4980 FOR S%=1% TO C3%-C2% 5000 S1%=S%-1% 5020 IF A2$(S%)>=A2$(S1%) THEN 5080 5040 T$=A2$(S%) : A2$(S%)=A2$(S1%) : A2$(S1%)=T$ 5060 T2%=1% 5080 NEXT S% 5100 IF T2%=0% THEN 5140 5120 NEXT R% 5140 FOR R%=C2% TO C3% 5160 S%=R%-C2% 5180 LSET P$(P%)=A2$(S%) 5200 IF P%<62% THEN P%=P%+1% ELSE P%=0% : P0%=P0%+1% : PUT #1%, RECORD P0% 5220 NEXT R% 5240 RETURN 5260 END