SUBROUTINE MAIN INTEGER NLINES, SUM, I, ASSNGI, N, GETLIN, EOR, OPEN, OUTFIL, IEOF *, J INTEGER STATUS, MAKRUN, SUNIT, NRUNS LOGICAL*1 BUF(512) COMMON / SELECT / TAPE, A(4), D(4), LEVEL, UNIT(4), T(4), FILE(40, * 4) INTEGER TAPE INTEGER A INTEGER D INTEGER LEVEL INTEGER UNIT INTEGER T LOGICAL*1 FILE COMMON / CSORT / LINPTR(750), BLANKS, DICT, FOLD, NOPRT, MERG, REV *ERS, SUBF, COFSET, IFOUT, OFILE(40), LINBUF(18000) INTEGER LINPTR INTEGER BLANKS INTEGER DICT INTEGER FOLD INTEGER NOPRT INTEGER MERG INTEGER REVERS INTEGER SUBF INTEGER COFSET INTEGER IFOUT LOGICAL*1 OFILE LOGICAL*1 LINBUF CALL SRTINT STATUS = 0 NRUNS = 0 23000 CONTINUE IF (.NOT.(STATUS .EQ. 0))GOTO 23003 STATUS = MAKRUN(NLINES) NRUNS = NRUNS + 1 IF (.NOT.(MERG .EQ. 0))GOTO 23005 CALL QUICK(LINPTR, NLINES, LINBUF) 23005 CONTINUE IF (.NOT.(NRUNS .EQ. 1))GOTO 23007 IF (.NOT.(STATUS .EQ. -3))GOTO 23009 CALL REDOUT CALL PUTRUN(LINPTR, NLINES, LINBUF, 2) RETURN 23009 CONTINUE CALL FSETUP 23010 CONTINUE 23007 CONTINUE GOTO 23004 23003 CONTINUE NLINES = 0 23004 CONTINUE IF (.NOT.(SUM(D, 4-1) .GT. 0 .OR. NLINES .GT. 0))GOTO 23011 CALL STAPE IF (.NOT.(A(TAPE) .GT. 1))GOTO 23013 CALL PUTEOR(UNIT(TAPE)) 23013 CONTINUE CALL PUTRUN(LINPTR, NLINES, LINBUF, UNIT(TAPE)) 23011 CONTINUE 23001 IF (.NOT.(SUM(D, 4-1) .EQ. 0 .AND. STATUS .EQ. -3))GOTO 23000 23002 CONTINUE I=1 23015 IF (.NOT.(I .LT. 4))GOTO 23017 T(I) = I IF (.NOT.(ASSNGI(FILE(1,I), 1, UNIT(I)) .EQ. -3))GOTO 23018 CALL CANT(FILE(1,I)) 23018 CONTINUE 23016 I=I+1 GOTO 23015 23017 CONTINUE UNIT(4) = OPEN(FILE(1,4), 2) IF (.NOT.(UNIT(4) .EQ. -3))GOTO 23020 CALL CANT(FILE(1,4)) 23020 CONTINUE T(4) = 4 23022 CONTINUE OUTFIL = T(4) IF (.NOT.(LEVEL .EQ. 1))GOTO 23025 SUNIT = UNIT(OUTFIL) CALL REDOUT UNIT(OUTFIL) = 2 23025 CONTINUE 23027 CONTINUE CALL MRGRUN(IEOF) IF (.NOT.(IEOF .EQ. 0))GOTO 23030 CALL PUTEOR(UNIT(OUTFIL)) 23030 CONTINUE 23028 IF (.NOT.(IEOF .GT. 0))GOTO 23027 23029 CONTINUE IF (.NOT.(LEVEL .EQ. 1))GOTO 23032 UNIT(OUTFIL) = SUNIT GOTO 23024 23032 CONTINUE I = T(IEOF) J = T(4) IF (.NOT.(ASSNGI(FILE(1,I), 2, UNIT(I)) .EQ. -3))GOTO 23034 CALL CANT(FILE(1,I)) 23034 CONTINUE IF (.NOT.(ASSNGI(FILE(1,J), 1, UNIT(J)) .EQ. -3))GOTO 23036 CALL CANT(FILE(1,J)) 23036 CONTINUE T(4) = I T(IEOF) = J LEVEL = LEVEL - 1 23023 IF (.NOT.(LEVEL .EQ. 0))GOTO 23022 23024 CONTINUE CALL CLEANS RETURN END SUBROUTINE CLEANS INTEGER I COMMON / SELECT / TAPE, A(4), D(4), LEVEL, UNIT(4), T(4), FILE(40, * 4) INTEGER TAPE INTEGER A INTEGER D INTEGER LEVEL INTEGER UNIT INTEGER T LOGICAL*1 FILE I=1 23038 IF (.NOT.(I .LE. 4))GOTO 23040 IF (.NOT.(UNIT(I) .GT. 0))GOTO 23041 CALL CLOSE(UNIT(I)) CALL REMOVE(FILE(1,I)) 23041 CONTINUE 23039 I=I+1 GOTO 23038 23040 CONTINUE RETURN END INTEGER FUNCTION COMPAR(LP1, LP2, LIN) LOGICAL*1 LIN(100) INTEGER I, J, LP1, LP2 INTEGER TYPE, CT LOGICAL*1 C1,C2 LOGICAL*1 CLOWER COMMON / CSORT / LINPTR(750), BLANKS, DICT, FOLD, NOPRT, MERG, REV *ERS, SUBF, COFSET, IFOUT, OFILE(40), LINBUF(18000) INTEGER LINPTR INTEGER BLANKS INTEGER DICT INTEGER FOLD INTEGER NOPRT INTEGER MERG INTEGER REVERS INTEGER SUBF INTEGER COFSET INTEGER IFOUT LOGICAL*1 OFILE LOGICAL*1 LINBUF I = LP1 J = LP2 IF (.NOT.(BLANKS .EQ. 1))GOTO 23043 23045 IF (.NOT.(LIN(I) .EQ. 32))GOTO 23046 I = I + 1 GOTO 23045 23046 CONTINUE 23047 IF (.NOT.(LIN(J) .EQ. 32))GOTO 23048 J = J + 1 GOTO 23047 23048 CONTINUE GOTO 23044 23043 CONTINUE IF (.NOT.(SUBF .EQ. 1))GOTO 23049 23051 IF (.NOT.(LIN(I) .NE. 0))GOTO 23052 I = I + 1 GOTO 23051 23052 CONTINUE 23053 IF (.NOT.(LIN(J) .NE. 0))GOTO 23054 J = J + 1 GOTO 23053 23054 CONTINUE IF (.NOT.(I .GT. LP1 + COFSET))GOTO 23055 I = LP1 + COFSET 23055 CONTINUE IF (.NOT.(J .GT. LP2 + COFSET))GOTO 23057 J = LP2 + COFSET 23057 CONTINUE 23049 CONTINUE 23044 CONTINUE 23059 CONTINUE IF (.NOT.(LIN(I) .EQ. 0))GOTO 23062 COMPAR = 0 RETURN 23062 CONTINUE IF (.NOT.(NOPRT .EQ. 1))GOTO 23064 23066 IF (.NOT.((LIN(I) .GT. 0 .AND. LIN(I) .LT. 32) .OR. LIN(I) .EQ. 12 *7))GOTO 23067 I = I + 1 GOTO 23066 23067 CONTINUE 23068 IF (.NOT.((LIN(J) .GT. 0 .AND. LIN(J) .LT. 32) .OR. LIN(J) .EQ. 12 *7))GOTO 23069 J = J + 1 GOTO 23068 23069 CONTINUE 23064 CONTINUE IF (.NOT.(DICT .EQ. 1))GOTO 23070 23072 CONTINUE CT = TYPE (LIN(I)) IF (.NOT.(CT .EQ. 1 .OR. CT .EQ. 2 .OR. CT.EQ. 32 .OR. CT .EQ. 0)) *GOTO 23075 GOTO 23074 23075 CONTINUE I = I + 1 23073 GOTO 23072 23074 CONTINUE 23077 CONTINUE CT = TYPE (LIN(J)) IF (.NOT.(CT .EQ. 1 .OR. CT .EQ. 2 .OR. CT .EQ. 32 .OR. CT .EQ. 0) *)GOTO 23080 GOTO 23079 23080 CONTINUE J = J + 1 23078 GOTO 23077 23079 CONTINUE 23070 CONTINUE IF (.NOT.(FOLD .EQ. 1))GOTO 23082 C1 = CLOWER (LIN(I)) C2 = CLOWER(LIN(J)) GOTO 23083 23082 CONTINUE C1 = LIN(I) C2 = LIN(J) 23083 CONTINUE IF (.NOT.(C1 .NE. C2))GOTO 23084 GOTO 23061 23084 CONTINUE I = I + 1 J = J + 1 23060 GOTO 23059 23061 CONTINUE IF (.NOT.(C1 .LT. C2 ))GOTO 23086 COMPAR = -1 GOTO 23087 23086 CONTINUE COMPAR = +1 23087 CONTINUE IF (.NOT.(REVERS .EQ. 1))GOTO 23088 COMPAR = -COMPAR 23088 CONTINUE RETURN END INTEGER FUNCTION EOR(BUFFER) LOGICAL*1 BUFFER(100) IF (.NOT.(BUFFER(1) .EQ. 4 .AND. BUFFER(2) .EQ. 10))GOTO 23090 EOR = 1 GOTO 23091 23090 CONTINUE EOR = 0 23091 CONTINUE RETURN END SUBROUTINE EXCHAN(LP1, LP2, LINBUF) LOGICAL*1 LINBUF(100) INTEGER K, LP1, LP2 K = LP1 LP1 = LP2 LP2 = K RETURN END SUBROUTINE FSETUP LOGICAL*1 TEMP(4) INTEGER I, N, ITOC, OPEN COMMON / SELECT / TAPE, A(4), D(4), LEVEL, UNIT(4), T(4), FILE(40, * 4) INTEGER TAPE INTEGER A INTEGER D INTEGER LEVEL INTEGER UNIT INTEGER T LOGICAL*1 FILE TAPE = 1 LEVEL = 1 I=1 23092 IF (.NOT.(I .LE. 4))GOTO 23094 A(I) = 1 D(I) = 1 TEMP(1) = 115 N = ITOC(I, TEMP(2), 3) CALL SCRATF(TEMP, FILE(1,I)) IF (.NOT.(I .LT. 4))GOTO 23095 UNIT(I) = OPEN(FILE(1,I), 2) IF (.NOT.(UNIT(I) .EQ. -3))GOTO 23097 CALL CANT(FILE(1,I)) 23097 CONTINUE GOTO 23096 23095 CONTINUE UNIT(I) = 0 23096 CONTINUE 23093 I=I+1 GOTO 23092 23094 CONTINUE D(4) = 0 A(4) = 0 RETURN END SUBROUTINE FSTACK (IARG) INTEGER I LOGICAL*1 IARG(40) COMMON /FLIST/ FLEVEL, FFILES(40, 25) INTEGER FLEVEL LOGICAL*1 FFILES IF (.NOT.(FLEVEL .LT. 25))GOTO 23099 FLEVEL = FLEVEL + 1 I=1 23101 IF (.NOT.(I.LE.40))GOTO 23103 FFILES(I,FLEVEL) = IARG(I) 23102 I=I+1 GOTO 23101 23103 CONTINUE 23099 CONTINUE RETURN END INTEGER FUNCTION GSRTLN(BUF) LOGICAL*1 BUF(512) INTEGER GETLIN, INIT, LEVEL, FOPEN, OPEN, INFILE COMMON /FLIST/ FLEVEL, FFILES(40, 25) INTEGER FLEVEL LOGICAL*1 FFILES DATA INIT/0/ IF (.NOT.(INIT .EQ. 0))GOTO 23104 LEVEL = 0 IF (.NOT.(FLEVEL .EQ. 0))GOTO 23106 FLEVEL = 1 CALL SCOPY(1H-, 1, FFILES(1,1), 1) 23106 CONTINUE INIT = 1 FOPEN = 0 23104 CONTINUE IF (.NOT.(FOPEN .EQ. 0 .AND. LEVEL .EQ. FLEVEL))GOTO 23108 GSRTLN = -3 GOTO 23109 23108 CONTINUE IF (.NOT.(FOPEN .EQ. 0))GOTO 23110 FOPEN = 1 LEVEL = LEVEL + 1 IF (.NOT.(FFILES(1, LEVEL) .EQ. 45))GOTO 23112 INFILE = 1 GOTO 23113 23112 CONTINUE INFILE = OPEN(FFILES(1, LEVEL), 1) IF (.NOT.(INFILE .EQ. -3))GOTO 23114 CALL CANT(FFILES(1, LEVEL)) 23114 CONTINUE 23113 CONTINUE 23110 CONTINUE GSRTLN = GETLIN(BUF, INFILE) IF (.NOT.(GSRTLN .EQ. -1))GOTO 23116 FOPEN = 0 IF (.NOT.(INFILE .NE. 1))GOTO 23118 CALL CLOSE(INFILE) 23118 CONTINUE 23116 CONTINUE 23109 CONTINUE RETURN END INTEGER FUNCTION MAKRUN(NLINES) INTEGER NLINES, LBP, LEN, GSRTLN COMMON / CSORT / LINPTR(750), BLANKS, DICT, FOLD, NOPRT, MERG, REV *ERS, SUBF, COFSET, IFOUT, OFILE(40), LINBUF(18000) INTEGER LINPTR INTEGER BLANKS INTEGER DICT INTEGER FOLD INTEGER NOPRT INTEGER MERG INTEGER REVERS INTEGER SUBF INTEGER COFSET INTEGER IFOUT LOGICAL*1 OFILE LOGICAL*1 LINBUF NLINES = 0 LBP = 1 23120 CONTINUE LEN = GSRTLN(LINBUF(LBP)) IF (.NOT.(LEN .EQ. -3))GOTO 23123 GOTO 23122 23123 CONTINUE IF (.NOT.(LEN .EQ. -1 .AND. MERG .EQ. 1))GOTO 23125 GOTO 23122 23125 CONTINUE IF (.NOT.(LEN .NE. -1))GOTO 23127 NLINES = NLINES + 1 LINPTR(NLINES) = LBP LBP = LBP + LEN + 1 IF (.NOT.(LBP .GE. 18000 - 512 .OR. NLINES .GE. 750))GOTO 23129 GOTO 23122 23129 CONTINUE 23127 CONTINUE 23121 GOTO 23120 23122 CONTINUE IF (.NOT.(LEN .EQ. -3))GOTO 23131 MAKRUN = -3 GOTO 23132 23131 CONTINUE MAKRUN = 0 23132 CONTINUE RETURN END SUBROUTINE MRGRUN(IEOF) INTEGER OUTFIL, LBP, NF, I, K, N, GETLIN, EOR, IEOF COMMON / SELECT / TAPE, A(4), D(4), LEVEL, UNIT(4), T(4), FILE(40, * 4) INTEGER TAPE INTEGER A INTEGER D INTEGER LEVEL INTEGER UNIT INTEGER T LOGICAL*1 FILE COMMON / CSORT / LINPTR(750), BLANKS, DICT, FOLD, NOPRT, MERG, REV *ERS, SUBF, COFSET, IFOUT, OFILE(40), LINBUF(18000) INTEGER LINPTR INTEGER BLANKS INTEGER DICT INTEGER FOLD INTEGER NOPRT INTEGER MERG INTEGER REVERS INTEGER SUBF INTEGER COFSET INTEGER IFOUT LOGICAL*1 OFILE LOGICAL*1 LINBUF OUTFIL = T(4) LBP = 1 NF = 0 IEOF = 0 I=1 23133 IF (.NOT.(I .LT. 4))GOTO 23135 K = T(I) N = GETLIN(LINBUF(LBP), UNIT(K)) IF (.NOT.(N .NE. -1 .AND. EOR(LINBUF(LBP)) .NE. 1))GOTO 23136 NF = NF + 1 LINPTR(NF) = LBP GOTO 23137 23136 CONTINUE IF (.NOT.(N .EQ. -1))GOTO 23138 IEOF = I 23138 CONTINUE 23137 CONTINUE LBP = LBP + 512 23134 I=I+1 GOTO 23133 23135 CONTINUE CALL QUICK(LINPTR, NF, LINBUF) 23140 IF (.NOT.(NF .GT. 0))GOTO 23141 LBP = LINPTR(1) CALL PUTLIN(LINBUF(LBP), UNIT(OUTFIL)) I = LBP / 512 + 1 K = T(I) N = GETLIN(LINBUF(LBP), UNIT(K)) IF (.NOT.(N .EQ. -1 .OR. EOR(LINBUF(LBP)) .EQ. 1))GOTO 23142 LINPTR(1) = LINPTR(NF) NF = NF - 1 IF (.NOT.(N .EQ. -1))GOTO 23144 IEOF = I 23144 CONTINUE 23142 CONTINUE CALL REHEAP(LINPTR, NF, LINBUF) GOTO 23140 23141 CONTINUE RETURN END SUBROUTINE PUTEOR(INT) INTEGER INT CALL PUTCH(4, INT) CALL PUTCH(10, INT) RETURN END SUBROUTINE PUTRUN(LINPTR, NLINES, LINBUF, OUTFIL) LOGICAL*1 LINBUF(18000) INTEGER I, J, LINPTR(750), NLINES, OUTFIL I=1 23146 IF (.NOT.(I .LE. NLINES))GOTO 23148 J = LINPTR(I) CALL PUTLIN(LINBUF(J), OUTFIL) 23147 I=I+1 GOTO 23146 23148 CONTINUE RETURN END SUBROUTINE QUICK(LINPTR, NLINES, LINBUF) LOGICAL*1 LINBUF(100) INTEGER COMPAR INTEGER I, J, LINPTR(100), LV(20), NLINES, P, PIVLIN, UV(20) LV(1) = 1 UV(1) = NLINES P = 1 23149 IF (.NOT.(P .GT. 0))GOTO 23150 IF (.NOT.(LV(P) .GE. UV(P)))GOTO 23151 P = P - 1 GOTO 23152 23151 CONTINUE I = LV(P) - 1 J = UV(P) PIVLIN = LINPTR(J) 23153 IF (.NOT.(I .LT. J))GOTO 23154 I=I+1 23155 IF (.NOT.(COMPAR(LINPTR(I), PIVLIN, LINBUF) .LT. 0))GOTO 23157 23156 I=I+1 GOTO 23155 23157 CONTINUE J = J - 1 23158 IF (.NOT.(J .GT. I))GOTO 23160 IF (.NOT.(COMPAR(LINPTR(J), PIVLIN, LINBUF) .LE. 0))GOTO 23161 GOTO 23160 23161 CONTINUE 23159 J = J - 1 GOTO 23158 23160 CONTINUE IF (.NOT.(I .LT. J))GOTO 23163 CALL EXCHAN(LINPTR(I), LINPTR(J), LINBUF) 23163 CONTINUE GOTO 23153 23154 CONTINUE J = UV(P) CALL EXCHAN(LINPTR(I), LINPTR(J), LINBUF) IF (.NOT.(I-LV(P) .LT. UV(P)-I))GOTO 23165 LV(P+1) = LV(P) UV(P+1) = I - 1 LV(P) = I + 1 GOTO 23166 23165 CONTINUE LV(P+1) = I + 1 UV(P+1) = UV(P) UV(P) = I - 1 23166 CONTINUE P = P + 1 23152 CONTINUE GOTO 23149 23150 CONTINUE RETURN END SUBROUTINE REDOUT INTEGER ASSNGI COMMON / CSORT / LINPTR(750), BLANKS, DICT, FOLD, NOPRT, MERG, REV *ERS, SUBF, COFSET, IFOUT, OFILE(40), LINBUF(18000) INTEGER LINPTR INTEGER BLANKS INTEGER DICT INTEGER FOLD INTEGER NOPRT INTEGER MERG INTEGER REVERS INTEGER SUBF INTEGER COFSET INTEGER IFOUT LOGICAL*1 OFILE LOGICAL*1 LINBUF IF (.NOT.(IFOUT .EQ. 1))GOTO 23167 IF (.NOT.(ASSNGI(OFILE, 2, 2) .EQ. -3))GOTO 23169 CALL REMARK(43HCannot redirect standard output to +o file.) 23169 CONTINUE 23167 CONTINUE RETURN END SUBROUTINE REHEAP(LINPTR, NF, LINBUF) LOGICAL*1 LINBUF(18000) INTEGER COMPAR INTEGER I, J, NF, LINPTR(100) I = 1 23171 IF (.NOT.(2 * I .LE. NF))GOTO 23173 J = 2 * I IF (.NOT.(J .LT. NF))GOTO 23174 IF (.NOT.(COMPAR(LINPTR(J), LINPTR(J+1), LINBUF) .GT. 0))GOTO 2317 *6 J = J + 1 23176 CONTINUE 23174 CONTINUE IF (.NOT.(COMPAR(LINPTR(I), LINPTR(J), LINBUF) .LE. 0))GOTO 23178 GOTO 23173 23178 CONTINUE CALL EXCHAN(LINPTR(I), LINPTR(J), LINBUF) 23172 I = J GOTO 23171 23173 CONTINUE RETURN END SUBROUTINE SRTINT LOGICAL*1 TEMP(40), CLOWER INTEGER I, N, GETARG, INDEX, CTOI, J COMMON / SELECT / TAPE, A(4), D(4), LEVEL, UNIT(4), T(4), FILE(40, * 4) INTEGER TAPE INTEGER A INTEGER D INTEGER LEVEL INTEGER UNIT INTEGER T LOGICAL*1 FILE COMMON / CSORT / LINPTR(750), BLANKS, DICT, FOLD, NOPRT, MERG, REV *ERS, SUBF, COFSET, IFOUT, OFILE(40), LINBUF(18000) INTEGER LINPTR INTEGER BLANKS INTEGER DICT INTEGER FOLD INTEGER NOPRT INTEGER MERG INTEGER REVERS INTEGER SUBF INTEGER COFSET INTEGER IFOUT LOGICAL*1 OFILE LOGICAL*1 LINBUF COMMON /FLIST/ FLEVEL, FFILES(40, 25) INTEGER FLEVEL LOGICAL*1 FFILES CALL QUERY(48Husage: sort [-bdfimr] [+ofile] [+sn] [file] ...) FLEVEL = 0 BLANKS = 0 DICT = 0 FOLD = 0 NOPRT = 0 MERG = 0 REVERS = 0 SUBF = 0 COFSET = 0 IFOUT = 0 I=1 23180 IF (.NOT.(GETARG(I, TEMP, 40) .NE. -1))GOTO 23182 J=1 23183 IF (.NOT.(TEMP(J) .NE. 0))GOTO 23185 TEMP(J) = CLOWER(TEMP(J)) 23184 J=J+1 GOTO 23183 23185 CONTINUE IF (.NOT.(TEMP(1) .EQ. 45 .AND. TEMP(2) .NE. 0))GOTO 23186 IF (.NOT.(INDEX(TEMP, 98) .GT. 0))GOTO 23188 BLANKS = 1 23188 CONTINUE IF (.NOT.(INDEX(TEMP, 100) .GT. 0))GOTO 23190 DICT = 1 23190 CONTINUE IF (.NOT.(INDEX(TEMP, 102) .GT. 0))GOTO 23192 FOLD = 1 23192 CONTINUE IF (.NOT.(INDEX(TEMP, 105) .GT. 0))GOTO 23194 NOPRT = 1 23194 CONTINUE IF (.NOT.(INDEX(TEMP, 109) .GT. 0))GOTO 23196 MERG = 1 23196 CONTINUE IF (.NOT.(INDEX(TEMP, 114) .GT. 0))GOTO 23198 REVERS = 1 23198 CONTINUE GOTO 23187 23186 CONTINUE IF (.NOT.(TEMP(1) .EQ. 43 .AND. CLOWER(TEMP(2)) .EQ. 115))GOTO 232 *00 SUBF = 1 N = 3 COFSET = CTOI(TEMP, N) - 1 IF (.NOT.(COFSET .LT. 0))GOTO 23202 COFSET = 0 23202 CONTINUE GOTO 23201 23200 CONTINUE IF (.NOT.(TEMP(1) .EQ. 43 .AND. CLOWER(TEMP(2)) .EQ. 111))GOTO 232 *04 IFOUT = 1 CALL SCOPY(TEMP, 3, OFILE, 1) GOTO 23205 23204 CONTINUE CALL FSTACK(TEMP) 23205 CONTINUE 23201 CONTINUE 23187 CONTINUE 23181 I=I+1 GOTO 23180 23182 CONTINUE RETURN END SUBROUTINE STAPE INTEGER I, Z COMMON / SELECT / TAPE, A(4), D(4), LEVEL, UNIT(4), T(4), FILE(40, * 4) INTEGER TAPE INTEGER A INTEGER D INTEGER LEVEL INTEGER UNIT INTEGER T LOGICAL*1 FILE IF (.NOT.(D(TAPE) .LT. D(TAPE+1)))GOTO 23206 TAPE = TAPE + 1 GOTO 23207 23206 CONTINUE IF (.NOT.(D(TAPE) .EQ. 0))GOTO 23208 LEVEL = LEVEL + 1 Z = A(1) I=1 23210 IF (.NOT.(I .LT. 4))GOTO 23212 D(I) = Z + A(I+1) - A(I) A(I) = Z + A(I+1) 23211 I=I+1 GOTO 23210 23212 CONTINUE 23208 CONTINUE TAPE = 1 23207 CONTINUE D(TAPE) = D(TAPE) - 1 RETURN END INTEGER FUNCTION SUM(ARRAY, N) INTEGER ARRAY(100), N, I SUM = 0 I=1 23213 IF (.NOT.(I.LE.N))GOTO 23215 SUM = SUM + ARRAY(I) 23214 I=I+1 GOTO 23213 23215 CONTINUE RETURN END