C** MOVEB ** SUBROUTINE TO MOVE CHARACTERS FROM 1 ARRAY TO ANOTHER ****
C                   RT11/DOS
C
C
	SUBROUTINE MOVEB (SARAY, FROM, TO, OBARAY, START,N)
C
	INTEGER FROM, TO, START
	LOGICAL*1 SARAY(TO),OBARAY(N)
C
	STAR=START
	DO 1 I=FROM, TO
	OBARAY(STAR)=SARAY(I)
1	STAR=STAR+1
	RETURN
	END
C** CHARB ** SUBROUTINE TO CAN AN ARRAY FOR A GIVEN CHARACTER ****
C                        RT11
C
C
	SUBROUTINE CHARB (ICTL, IARAY, IFIRST, ILAST, ICHR, ICOL)
C
C--THIS SUBROUTINE SCANS AN ARRAY (IARAY) FROM IFIRST TO ILAST
C--IF ICTL IS POSITIVE; OR FROM ILAST TO IFIRST IF ICTL IS NON POSITIVE
C--AND RETURNS IN ICOL THE NUMBER OF THE ARRAY ELEMENT THAT MATCHES 
C--THE CHARACTER SPECIFIED IN ICHR.
C--IF NO MATCH IS FOUND ICOL IS RETURNED AS -1.
C
	LOGICAL*1 IARAY(ILAST), ICHR
	IF (IFIRST .GT. ILAST ) GO TO 3
	IF (ICTL) 6,6,1
C
C--FORWARD SEARCH
C
1	DO 2 I=IFIRST,ILAST
	IF (ICHR .EQ. IARAY(I)) GO TO 4
2	CONTINUE
3	ICOL=-1
	RETURN
4	ICOL=I
5	RETURN
C
C--BACKWARD SEARCH
C
6	DO 7 ICOL=ILAST,IFIRST,-1
	IF (ICHAR .EQ. IARAY(ICOL)) GO TO 5
7	CONTINUE
	GO TO 3
	END
C** BLANKB ** SUBROUTINE TO FIND THE FIRST NON BLANK CHAR IN AN ARRAY **
C                         RT11
C
C--THIS ROUTINE SEARCHES AN ALPHA ARRAY IN A1 FORMAT FROM THE RIGHT,
C--IF ICTL IS NEGATIVE, OR FROM THE LEFT, IF ICTL IS POSITIVE
C---AND RETURNS IN IFOUND THE ELEMENT NUMBER OF THE FIRST NON-
C----BLANK CHARACTER FOUND. IF THE WHOLE ARRAY IS BLANK, IFOUND
C-----IS RETURNED AS -1.
C
C
	SUBROUTINE BLANKB (ICTL, IARAY, IFIRST, ILAST, IFOUND)
C
	LOGICAL*1 IARAY(ILAST), NBLK
	DATA NBLK/' '/
	IFOUND=-1
	IF (IFIRST .GE. ILAST)RETURN
1	IF (ICTL) 2,4,4
C--BACKWARDS SEARCH
2	DO 3 ICOL=ILAST,IFIRST,-1
	IF (IARAY(ICOL) .NE. NBLK) GO TO 6
3	CONTINUE
	RETURN
C---FORWARD SEARCH
4	DO 5 ICOL=IFIRST,ILAST
	IF (IARAY(ICOL) .NE. NBLK) GO TO 6
5	CONTINUE
	RETURN
6	IFOUND=ICOL
	RETURN
	END
C** RENUM1 ** SUBROUTINE FOR RENUM TO FIND THE STATE.NUM LABELS
C
	SUBROUTINE RENUM1
C
	LOGICAL*1 LINE(120)
	LOGICAL*1 IC,ID,DEBUG,TAB,NBLK
	COMMON ICOUNT,OLD(499),LINE,IDUMMY(2902),DEBUG
	DATA IC/'C'/,ID/'D'/,NBLK/' '/
C
C
	ICOUNT=0
	TAB="11
	IEND=5		!CHECK ONLY THE STATEMENT NUM FIELD
C
C============READ A LINE
C
2	READ (1,4,END=6) IQ,LINE
4	FORMAT (Q,120A1)
	IF (IQ .LE. 3) GO TO 2				!SKIP NON-LINES
	IF (LINE(1) .EQ. IC) GO TO 2			!SKIP COMMENTS
	IF (LINE(1) .EQ. ID .AND. .NOT. DEBUG) GO TO 2	!DEBUG LINES
	IF (LINE(1) .EQ. TAB) GO TO 2		!CANNOT CONTAIN A NUM
C
	ISTART=1
	IOLD=NUMOLD(LINE,IEND,ISTART,ISTOP)
	IF (IOLD .EQ. 0) GO TO 2			!NONE FOUND
	ICOUNT=ICOUNT+1				!FOUND ONE, FILE IT
	OLD(ICOUNT)=IOLD
	IF (ICOUNT .LT. 499) GO TO 2
	STOP 'ABORTING-TOO MANY STATEMENT NUMBERS IN PROGRAM'
C
6	CONTINUE
D	WRITE (6,8) ICOUNT,(OLD(N),N=1,ICOUNT)
D8	FORMAT (' ICOUNT=',I7/10(10F7.0/))
	RETURN
	END
C** RENUM2 ** SUBROUTINE TO RENUMBER PROGRAMS FOR RENUM
C
C
	SUBROUTINE RENUM2 (IERROR)
C
	LOGICAL*1 LINE(120),KEYWD(72),TEST(9),HOLD(54),PACK(8)
	LOGICAL*1 IZERO,NBLK,ICOMA,IEQ,LEXPT,FFEED
	LOGICAL*1 IC,ID,TAB,DEBUG,ICON,RPAREN,LPAREN
	LOGICAL*1 ITO,FLAG
	COMMON ICOUNT,OLD(499),LINE,HOLD,PACK,IDUMMY(2871),
	1DEBUG			!-3961 WORDS TO DEBUG
	DATA IC/'C'/,ID/'D'/,RPAREN/')'/,LPAREN/'('/
	DATA ITO/'T'/,ICOMA/','/,IEQ/'='/,LEXPT/'!'/
	DATA TEST/'R','W','I','D','G','E','A','T','P'/
	DATA IZERO/'0'/,NBLK/' '/
C
	DATA KEYWD/5,'R','E','A','D','(',6,'W','R','I','T','E',
	1'(',3,'I','F','(',2,'D','O',4,'G','O','T','O',
	27,'E','N','C','O','D','E','(',7,'D','E','C','O',
	3'D','E','(',6,'A','S','S','I','G','N',4,'T','Y','P',
	4'E',5,'P','R','I','N','T',6,'A','C','C','E','P','T',
	54,'R','E','A','D',0/
C
C
C	THIS PROGRAM SEEKS OUT STATEMENT NUMBERS IN THOSE STATEMENTS
C	THAT CAN HAVE THEM AND CONVERTS THEM TO A NEW, SEQUENTIAL 
C	SERIES OF NUMBERS TO MAKE PROGRAM MAINTENANCE EASIER.
C	THE OLD STATEMENT NUMBERS MAY NOT EXTEND OVER THE END OF
C	A LINE ONTO A CONTINUATION LINE. STATEMENT NUMBERS MAY APPEAR
C	ON CONTINUATION LINES ONLY IN 'IF' AND 'GO TO' STATEMENTS.
C	IF THE ORIGINAL CODE HAS SEQUENCING IN COL 73-80, IT IS
C	DELETED FORM THE OUTPUT CODE.  IF LINES GO PAST COL
C	72 BEACUSE THE NEW STATEMENT NUMBERS ARE LONGER THE THE OLD
C	ONES, THE EXCESS IS MOVED TO THE NEXT LINE (IF IT IS A CONTIN-
C	UATION) OR A NEW CONTINUATION LINE IS CREATED FOR IT; EXCEPT 
C	THAT END-OF-LINE COMMENTS ARE DELETED RATHER THEN MOVED.
C	USE OF FORTRAN KEYWORDS AS VARIABLE NAMES MAY CONFUSE
C	THE SCAN IN UNPREDICTABLE WAYS AND IS BEST AVOIDED.
C	CAPACITY IS 499 STATEMENT NUMERS (LABELS),PROGRAM
C	ABORTS IF THIS IS EXCEEDED.
C	STATEMENT NUMBERS UP TO 99999 ARE ALLOWED.
C	THE USE OF MULTI DIMENTIONAL ARRAYS AS LOGICAL UNIT NUMBERS
C	IN I/O STATEMENTS IS NOT ALLOWED (EG READ(ARRAY(1,7),8) LIST).
C	AN ERROR MESSAGE IS ISSUED IF:
C (1)   RENUM FINDS A STATEMENT NUMBER IN A STATEMENT WHICH IT
C	DID NOT FIND USED AS A LABEL
C (2)   RENUM FINDS THE KEYWORD FOR A STATEMENT WHICH SHOULD CONTAIN
C	A STATEMENT NUMBER BUT THE LINE'S SYNTAX IS NOT CORRECT --CAUSED
C	BY USE OF KEYWORDS AS VARIABLE NAMES OR BY LINES WHICH DO NOT
C	HAVE THE NECESSARY SYNTAX ELEMENTS ON A SINGLE LINE FOR
C	RENUM'S ANALYSIS.
C
C
	TAB="11
	IHOLD=0
	HOLD(1)=TAB
	HOLD(2)="52		!ASCII '*'=CONTINUATION
	IERROR=0
	FLAG=.FALSE.
	FFEED="14
C
C======================== READ EACH LINE OF SOURCE CODE
C
2	CONTINUE
	READ (1,4,END=94) IEND,LINE
4	FORMAT (Q,120A1)
	IF (IEND .EQ. 0) GO TO 2		!SKIP BLANK LINES
	IF (IEND .GT. 72) IEND=72		!SUPPRESS SEQUENCE FIELD
	IF (LINE(1) .EQ. IC) GO TO 96			!SKIP COMMENTS
	IF (LINE(1) .EQ. ID .AND. .NOT. DEBUG) GO TO 96	!DEBUG
C
C======================== CONTINUATION LINES
C
	ICON=.FALSE.
	DO 6 ICOL=1,6
	IF (LINE(ICOL) .EQ. TAB) GO TO 8
6	CONTINUE
C
C--NO TAB FOUND, SO CHECK COL 6, ANYTHING BUT '0' OR ' ' = CONTINUATION
C
	ICOL=7
	IF (LINE(6) .NE. IZERO .AND. LINE(6) .NE. NBLK) ICON=.TRUE.
	GO TO 12
C
C--TAB FOUND SO IF THE NEXT CHAR IS NUMERIC, ITS A CONTINUATION
C
8	ICOL=ICOL+1
	IF (LINE(ICOL) .GT. "40 .AND. LINE(ICOL) .LT. "101) ICON=.TRUE.
10	IF (ICON) ICOL=ICOL+1
C
C==========TAKE CARE OF HOLDOVER FROM LAST LINE
C
12	IF (IHOLD .EQ. 0) GO TO 20
	IF (ICON) GO TO 14
C
C--HOLD CAN'T BE PART OF THIS LINE SO CREATE A NEW CONTINUATION LINE
C
	WRITE (2,92) (HOLD(I),I=1,IHOLD)
	IHOLD=0
	GO TO 20
C
C--THIS IS CONTINUATION, SO ADD CARRY-OVER TO IT, JUST AFTER IT'S CONTIN
C   UATION CHARACTER, SHIFT IT RIGHT TO MAKE ROOM. DO NOT INSERT
C   ANY COMMENTS FROM THE END OF THE LAST LINE.
C
14	CONTINUE
	IDELT=JHOLD-2
	IEND=IEND+IDELT
	DO 16 I=IEND,ICOL,-1		!SHIFT 'LINE' BY IDELT CHAR
	LINE(I)=LINE(I-IDELT)
16	CONTINUE
C
	DO 18 I=3,JHOLD			!MOVE 'HOLD' INTO 'LINE'
	LINE(ICOL)=HOLD(I)
	ICOL=ICOL+1
18	CONTINUE
	IHOLD=0
C
C=========PROCESS CONTINUATION LINES
C
20	CONTINUE
	ISTART=ICOL			!POINT TO START OF NEW LINE'S DATA
	IF (.NOT. ICON) GO TO 24		!NOT CONTINUATION
	IF (ITYPE .EQ. 0) GO TO 84		!NOT OF TYPE NEEDING ALALYSIS
	CALL CHARB(1,LINE,ICOL,IEND,LEXPT,LEND)	!LOOK FOR COMMENTS ON LINE
	IF (LEND .LE. 0) LEND=IEND
C
C--RESOLVE IF() THAT ENDED AT END OF PREVIOUS LINE
C
	IF (.NOT. FLAG) GO TO 22
	I=ICOL
	CALL BLANKB (1,LINE,I,LEND,ICOL)
	FLAG=.FALSE.
	IF (ICOL .LE. 0) GO TO 84
	IF (LINE(ICOL) .GT. "100) GO TO 26		!GO ANALYZE
	GO TO 80				!ARITHMETIC, GO CONVERT
C
22	IF (ITYPE .EQ. 3 .AND. NX .GT. 0) GO TO 72	!LOOK FOR ')'
	IF (ITYPE .EQ. 3 .AND. NX .EQ. 0) GO TO 80	!GO CONVERT
	IF (ITYPE .EQ. 5) GO TO 64			!CONTINUE GO TO'S
D	WRITE (6,24) ITYPE,(LINE(N),N=1,IEND)
D24	FORMAT (' WHAT?, ITYPE=',I4,1X,80A1)
	GO TO 98
C
C==========CONVERT STATEMENT NUMBER LABELS
C
24	IF (LINE(1) .EQ. TAB) GO TO 26		!CANNOT CONTAIN A STATE.NUM
	ISTART=1
	JEND=5					!DO ONLY LABEL FIELD
	IOLD=NUMOLD(LINE,JEND,ISTART,ISTOP)
	IF (IOLD .EQ. 0) GO TO 26			!NONE FOUND
C
C--PUT NEW NUMBER IN PLACE OF THE OLD ONE
C
	NEW=NEWNUM(ICOUNT,OLD,IOLD)
	IF (NEW .EQ. 0) GO TO 100
	I=IEND
	CALL PUTIT (LINE,IEND,ISTART,ISTOP,NEW,-1)
	ICOL=ICOL-(I-IEND)			!ADJUST ICOL
D	WRITE (5,28) NEW,IEND,ISTART,ISTOP
D28	FORMAT (I4,' IEND=',I3,' ISTART=',I3,'ISTOP=',I3)
C
C======================== FIND TYPE OF STATEMENT
C
26	CONTINUE
	FLAG=.FALSE.
	ITYPE=0
	NX=0
C
C-- FIRST A QUICK CHECK, IF FIRST LETTER OF STATEMENT IS NOT
C     ONE OF THESE, IT CANNOT CONTAIN A STATEMENT NUMBER
C
	DO 28 I=1,9
	IF (TEST(I) .EQ. LINE(ICOL)) GO TO 30
28	CONTINUE
	GO TO 90		!CANNOT CONTAIN A STATE.NUM.
C
C--PACK PART OF 'LINE' FOR KEYWORD ANALYSIS
C
30	CONTINUE
	I=ICOL-1
	DO 34 J=1,7
32	I=I+1
	IF (LINE(I) .EQ. NBLK) GO TO 32		!DELETE BLANKS
	PACK(J)=LINE(I)
34	CONTINUE
D	WRITE (5,40) ICOL,PACK
D40	FORMAT (I7,1X,8A1)
C
	L=0
36	M=L+2
	IF (KEYWD(L+1) .EQ. 0) GO TO 98
	L=KEYWD(L+1)+M-1
	ITYPE=ITYPE+1
	JCOL=1
D	WRITE (5,44) (KEYWD(NN),NN=M,L)
D44	FORMAT (1X,10A1)
	DO 38 I=M,L
	IF (PACK(JCOL) .NE. KEYWD(I)) GO TO 36
	JCOL=JCOL+1
38	CONTINUE
C
	ISTART=ICOL+JCOL-1		!FOUND A KEYWD MATCH
C
C-----------PROCESS READS AND WRITES AND ENCODES AND DECODES
C
	IF (ITYPE .GT. 2 .AND. ITYPE .NE. 6 .AND. ITYPE .NE. 7) GO TO 52
C
	CALL CHARB (1,LINE,ISTART-1,IEND,LPAREN,IFOUND)	!FIND START OF ()
	IF (IFOUND .LE. 0) GO TO 100
	I=0
	DO 40 LEND=IFOUND,IEND			!FIND END OF ()
	IF (LINE(LEND) .EQ. LPAREN) I=I+1
	IF (LINE(LEND) .EQ. RPAREN) I=I-1
	IF (I .EQ. 0) GO TO 42
40	CONTINUE
	GO TO 100
C
42	CALL CHARB (1,LINE,IFOUND+1,LEND,ICOMA,IFOUND)
	IF (IFOUND .LE. 0) GO TO 98		!CANNOT HAVE ANY NUMBERS
	CALL BLANKB(1,LINE,IFOUND+1,LEND,ISTOP)
	IF (ISTOP .LE. 0) GO TO 100
44	IF (LINE(ISTOP) .GT. "100) GO TO 48
46	ISTART=IFOUND+1
	ISTOP=ISTART
	IOLD=NUMOLD(LINE,LEND,ISTART,ISTOP)
	IF (IOLD .EQ. 0) GO TO 48
	NEW=NEWNUM(ICOUNT,OLD,IOLD)
	IF (NEW .EQ. 0) GO TO 100
	I=IEND
	CALL PUTIT (LINE,IEND,ISTART,ISTOP,NEW,1)
	LEND=LEND-(I-IEND)			!ADJUST LEND
48	IF (ITYPE .GT. 2) GO TO 50		!DONE WITH ENCODE/DECODE
C
	CALL CHARB (1,LINE,ISTOP,LEND,IEQ,IFOUND)	!LOOK FOR 'END='
	IF (IFOUND .GT. 0) GO TO 46
50	ITYPE=0					!NO MORE NUMBERS
	GO TO 84
C
C-------PROCESS PRINT,ACCEPT,TYPE,READ AND ASSIGN STATEMENTS
C
52	IF (ITYPE .LT. 8) GO TO 58
C
C--THE FORMAT WE'RE LOOKING FOR COULD BE AN ARRAY NAME OR A STATEMENT
C   NUMBER, SO CHECK THE NEXT CHAR AFTER THE KEYWORD TO SEE
C   IF ITS A DIGIT OR LETTER
C
	IF (PACK(JCOL) .LT. "60 .OR. PACK(JCOL) .GT. "71) GO TO 98
C
	DO 54 JEND=ISTART,IEND		!FIND END OF USEFUL PART OF LINE
	IF (LINE(JEND) .EQ. ITO .AND. ITYPE .EQ. 8) GO TO 56
	IF (LINE(JEND) .EQ. ICOMA .AND. ITYPE .NE. 8) GO TO 56
54	CONTINUE
	GO TO 100				!SOMETHING WRONG
C
56	IOLD=NUMOLD(LINE,JEND,ISTART,ISTOP)
	IF (IOLD .EQ. 0) GO TO 100		!SOMETHING WRONG
	NEW=NEWNUM(ICOUNT,OLD,IOLD)
	IF (NEW .EQ. 0) GO TO 100
	CALL PUTIT (LINE,IEND,ISTART,ISTOP,NEW,1)
	ITYPE=0
	GO TO 84
C
C------------PROCESS DO STATEMENTS
C
58	IF (ITYPE .NE. 4) GO TO 60
	IF (PACK(JCOL) .LT. "60 .OR. PACK(JCOL) .GT. "71) GO TO 98
	CALL CHARB (1,LINE,ISTART,IEND,IEQ,JEND)
D	WRITE (6,68) ISTART,JEND,(LINE(N),N=1,IEND)
D68	FORMAT (' DO''S-ISTART=',I4,' JEND=',I4,1X,80A1)
	IF (JEND .LE. 0) GO TO 100
	GO TO 56
C
C-------------PROCESS GO TO'S
C
60	CALL CHARB(1,LINE,ISTART,IEND,LEXPT,LEND)	!FIND COMMENTS
	IF (LEND .LE. 0) LEND=IEND
	JEND=LEND
C
62	IF (ITYPE .NE. 5) GO TO 70
C
	IF (PACK(JCOL) .GE. "60 .AND. PACK(JCOL) .LE. "71) GO TO 68
	CALL CHARB (1,LINE,ISTART,LEND,LPAREN,ISTART)
	IF (ISTART .LE. 0) GO TO 98		!HAS NO STATEMENT NUMBERS
C
64	CALL CHARB (1,LINE,ISTART,LEND,RPAREN,JEND)
	IF (JEND .LE. 0) JEND=LEND
	ISTOP=ISTART-1
66	ISTART=ISTOP+1
68	IOLD=NUMOLD (LINE,JEND,ISTART,ISTOP)
	IF (IOLD .EQ. 0) GO TO 84		!DONE WITH THIS LINE
	NEW=NEWNUM (ICOUNT, OLD,IOLD)
	IF (NEW .EQ. 0) GO TO 100
	I=IEND
	CALL PUTIT (LINE,IEND,ISTART,ISTOP,NEW,1)
	JEND=JEND-(I-IEND)		!ADJUST JEND
	LEND=LEND-(I-IEND)
	GO TO 66			!GO BACK FOR ANOTHER NUM ON THIS LINE
C
C------------PROCESS IF'S
C
70	CONTINUE
	CALL CHARB (1,LINE,ISTART-1,LEND,LPAREN,ICOL)
72	DO 74 I=ICOL,LEND				!FIND END OF ()
	IF (LINE(I) .EQ. LPAREN) NX=NX+1
	IF (LINE(I) .EQ. RPAREN) NX=NX-1
	IF (NX .EQ. 0) GO TO 76
74	CONTINUE
	GO TO 90			!WE'LL LOOK FURTHER ON NEXT LINE
C
C--FOUND END OF IF(), NOW A ALFA CHAR MEANS LOGICAL IF, DIGIT 
C   MEANS ARITHMENTIC IF. END OF LINE MEANS CHECK ON NEXT LINE
C
76	CALL BLANKB (1,LINE,I+1,LEND,ICOL)
	IF (ICOL .GT. 0) GO TO 78
	FLAG=.TRUE.			!TYPE IS UNRESOLVABLE
	GO TO 90
C
78	CONTINUE
	IF (LINE (ICOL) .GT. "100) GO TO 26		!IT'S LOGICAL
	IF (LINE(ICOL) .LT. "60 .OR. LINE(ICOL) .GT. "71) GO TO 98
	ISTATE=1					!IT'S ARITHMETIC
	ISTART=ICOL
C
C--CONVERT 3 STATEMENT NUMBERS
C
80	DO 82 ISTATE=ISTATE,3			!WATCH THIS
	IOLD=NUMOLD(LINE,LEND,ISTART,ISTOP)
	IF (IOLD .EQ. 0) GO TO 84
	NEW=NEWNUM(ICOUNT,OLD,IOLD)
	IF (NEW .EQ. 0) GO TO 100
	I=IEND
	CALL PUTIT (LINE,IEND,ISTART,ISTOP,NEW,1)
	LEND=LEND-(I-IEND)			!ADJUST LEND
	ISTART=ISTOP+1
82	CONTINUE
C
	ITYPE=0
C
C==================== WRITE THIS LINE OUT INTO NEW FILE
C
84	CONTINUE
	IF (IEND .LE. 72) GO TO 90
C
C--DECIDE WHAT TO DO ABOUT POSSIBLE END-OF-LINE COMMENTS
C
	IF (ITYPE .EQ. 3 .OR. ITYPE .EQ. 5) GO TO 86
	CALL CHARB (1,LINE,ISTART,IEND,LEXPT,LEND)
	IF (LEND .GT. 0) GO TO 86
	LEND=IEND			!NO COMMENTS 
	GO TO 88
C
C--GOT COMMENTS, IF EXCESS OVER 72 IS ALL COMMENTS, CHOP IT OFF
C
86	IF (LEND .GT. 72) GO TO 88
	IEND=72
	GO TO 90
C
C--SAVE THE EXCESS FOR THE NEXT LINE
C
88	CALL MOVEB (LINE,70,IEND,HOLD,3)
	JHOLD=LEND-70+2
	IF (LEND .EQ. IEND) JHOLD=JHOLD+1
	IHOLD=IEND-70+3				!NUM OF CHAR IN HOLD
	IEND=69
	IF (IHOLD .GT. 54) WRITE (2,102)
C
90	CONTINUE
	WRITE (2,92) (LINE(I),I=1,IEND)		!WRITE THIS LINE
92	FORMAT (120A1)
	GO TO 2					!GET NEXT LINE
C
94	CONTINUE			!DONE
	WRITE (2,92) FFEED		!FORM FEED ADDED TO END
	RETURN
C
96	CONTINUE
	IF (IHOLD .GT. 0) WRITE (6,92)(HOLD(N),N=1,IHOLD)
	IHOLD=0
98	CONTINUE				!RESET ITYPE AND PRINT
	ITYPE=0
	GO TO 90
C
100	CONTINUE				!FLAG ERRORS
	WRITE (2,102) 
102	FORMAT ('C?????POSSIBLE STATEMENT NUMBER CONVERSION ERROR
	1 IN FOLLOWING STATEMENT??????')
	IERROR=IERROR+1
	ITYPE=0
	GO TO 84
	END
C** NUMOLD ** FUNCTION TO GET A STATEMENT NUMBER FOR RENUM
C
C
	FUNCTION NUMOLD (LINE,IEND,ISTART,ISTOP)
C
	LOGICAL*1 NBLK,LINE(1),HOLD(5),TAB
	DATA NBLK/' '/
	TAB="11
C
C	FIRST LOOK FOR THE NEXT DIGIT IN 'LINE', STARTING AT 'ISTART'
C	THEN LOOK FOR THE NEXT NON-DIGIT: THAT DEFINES THE 
C	LOCATION OF THE NUMBER WE SEEK.
C	NOW PACK THE NUMBER IGNORING INBEDDED BLANKS AND
C	DECODE IT.
C
C--FIND THE START OF THE NUMBER (1ST DIGIT)
C
	IF (ISTART .GT. IEND) GO TO 4
	J=ISTART
	DO 2 ISTART=J,IEND
	IF (LINE(ISTART) .EQ. TAB) GO TO 4
	IF (LINE(ISTART) .GE. "60 .AND. LINE(ISTART) .LE. "71) GO TO 6
2	CONTINUE
4	NUMOLD=0
	RETURN
C
C--NOW FIND A NON-DIGIT (OTHER THEN BLANK) TO TERMINATE THE NUMBER
C
6	CONTINUE
	DO 8 ISTOP=ISTART,IEND
	IF (LINE(ISTOP) .EQ. NBLK) GO TO 8
	IF (LINE(ISTOP) .LT. "60 .OR. LINE(ISTOP) .GT. "71) GO TO 10
8	CONTINUE
	ISTOP=IEND+1
10	ISTOP=ISTOP-1
	IF (LINE(ISTOP) .EQ. NBLK) ISTOP=ISTOP-1
C
C--PACK THE NUMBER INTO AN ARRAY FOR DECODEING, RIGHT JUSTIFY
C
	J=5
	DO 12 I=ISTOP,ISTART,-1
	IF (LINE(I) .EQ. NBLK) GO TO 12
	HOLD(J)=LINE(I)
	J=J-1
12	CONTINUE
C
C--CLEAR REST OF HOLD
C
	IF (J .EQ. 0) GO TO 16
	DO 14 I=J,1,-1
	HOLD(I)=NBLK
14	CONTINUE
C
16	DECODE (5,18,HOLD) I
18	FORMAT (I5)
	NUMOLD=I
C
	RETURN
	END
C** NEWNUM ** FUNCTION FOR RENUM TO GET THE EQUIVALENT NEW STATE.NUM
C
C
	FUNCTION NEWNUM (ICOUNT,OLD,IOLD)
C
	DIMENSION OLD(1)
C
C	SEARCHES THE ARRAY OF OLD STATEMENT NUMBERS FOR THE POSITION
C	OF A SPECIFIED OLD NUMBER. THE EQUIVALENT NEW NUMBER
C	IS THE SUBSCRIPT OF 'OLD' WHERE IT WAS FOUND *2.
C
D	WRITE (5,2) ICOUNT,(OLD(N),N=1,10)
D2	FORMAT (I6,10F6.0)
	OLDNUM=IOLD
	DO 2 I=1,ICOUNT
	IF (OLD(I) .EQ. OLDNUM) GO TO 4
2	CONTINUE
C
	NEWNUM=0
	RETURN
C
4	NEWNUM=I*2
	RETURN
	END
C** PUTIT ** SUBROUTINE FOR RENUM TO PUT A STATE. NUM. INTO A LINE
C
C
	SUBROUTINE PUTIT (LINE,IEND,ISTART,ISTOP,NEW,ICTRL)
C
	LOGICAL*1 HOLD(5),LINE(1),NBLK,TAB,ID
	NBLK="40
	ID="104
	TAB="11
C
C	INSERT THE NEW STATEMENT NUMBER INTO 'LINE'. IF NOT THE
C	SAME NUMBER OF DIGITS AS THE OLD STATEMENT NUMBER, SHIFT
C	THE REST OF 'LINE' LEFT OR RIGHT AS NEEDED AND ADJUST 'IEND'
C	AND 'ISTOP' ACCORDINGLY. ALWAYS LEFT JUSTIFY THE NEW NUMBER
C	AGAINST 'ISTART'. EXCEPT FOR STATEMENT NUMBER LABELS (ICTRL<0)
C	IN CARD IMAGE FORMAT, WHICH ARE RIGHT JUSTIFIED IN COLS 1-5.
C
C
C--ENCODE THE NUMBER
C
	IF (NEW .LE. 0 .OR. NEW .GT. 998) STOP 'ABORTING--NEW 
	1NUMBER ERROR'
	ENCODE (5,2,HOLD) NEW
2	FORMAT (I5)
C
C--TAKE CARE OF SPECIAL CASE-CARD IMAGE LABELS
C
	IF (ICTRL .GT. 0 .OR. LINE(ISTOP+1) .EQ. TAB) GO TO 4
	ISTART=1
	IF (LINE(1) .EQ. ID) ISTART=2		!ALLOW FOR DEBUG
	ISTOP=5
	GO TO 12				!NO SHIFTING ALOWED
C
C--FIND NUMBER OF CHARACTERS IN THE NUMBER
C
4	I=3
	IF (HOLD(3) .EQ. NBLK) I=2
	IF (HOLD(4) .EQ. NBLK) I=1
C
C--J=NUMBER OF SPACES AVAILABLE IN 'LINE' TO PUT THE NUMBER IN
C
	J=ISTOP-ISTART+1
	IF (J .EQ. I) GO TO 12
	IDELT=J-I
	IEND=IEND-IDELT
	ISTOP=ISTOP-IDELT
	IF (J .LT. I) GO TO 8
C
C--SHIFT REST OF LINE TO THE LEFT (LEAVES GARBAGE TO RIGHT OF 'IEND')
C
	DO 6 ICOL=ISTART+I,IEND
	LINE(ICOL)=LINE(ICOL+IDELT)
6	CONTINUE
	GO TO 12
C
C--SHIFT REST OF LINE TO THE RIGHT TO MAKE ROOM
C
8	DO 10 ICOL=IEND,ISTART+I,-1
	LINE(ICOL)=LINE(ICOL+IDELT)		!IDELT <0
10	CONTINUE
C
C--MOVE THE NEW STATEMENT NUMBER INTO THE SPACE IN 'LINE'
C
12	I=5
	DO 14 J=ISTOP,ISTART,-1
	LINE(J)=HOLD(I)
	I=I-1
14	CONTINUE
D	WRITE (6,16) NEW
D16	FORMAT (' PUT ',I5)
C
	RETURN
C
	END
C** XREF1 ** SUBROUTINE TO PREPARE A CROSS REFERENCE LISTING
C
C
	SUBROUTINE XREF1
C
	DIMENSION IHOLD(3),INAME(3,120)
	LOGICAL*1 ICON,FFEED,IC,IEQ,DOT,HYF,HOLD(6),EXTRA,LEXPT
	LOGICAL*1 COUNT(120),HEADER(82),NAME(6,120),FLAG,DEBUG,ID
	LOGICAL*1 LOST,INSIDE,SLASH,INSID
	LOGICAL*1 END(4),DONE
	DATA END/'E','N','D','!'/
	LOGICAL*1 LINE(80),PACK(78),KEYWD(230),TAB,NBLK,HEAD(4)
	LOGICAL*1 IE,LPARN,RPARN,IPRINT,JPRINT,IZERO,NEW,IU,IO
	COMMON ICOUNT,NUMBER(120,30),NAME,DEBUG,HEADER,COUNT,IPRINT,
	1JPRINT,LOST
	EQUIVALENCE (IHOLD,HOLD),(INAME,NAME)
	DATA NBLK/' '/,IC/'C'/,IEQ/'='/,DOT/'.'/,IZERO/'0'/,SLASH/'/'/
	DATA HEAD/'C',2*'*',' '/,HYF/''''/,IE/'E'/
	DATA LPARN/'('/,RPARN/')'/,LEXPT/'!'/,ID/'D'/,IU/'U'/,IO/'O'/
C
	DATA KEYWD/9,'D','I','M','E','N','S','I','O','N',4,'D','A',
	1'T','A',6,'C','O','M','M','O','N',11,'E','Q','U','I','V',
	2'A','L','E','N','C','E',7,'L','O','G','I','C','A','L',7,
	3'I','N','T','E','G','E','R',4,'R','E','A','L',10,'D','E','F',
	4'I','N','E','F','I','L','E',8,'E','X','T','E','R','N','A','L',
	54,'T','Y','P','E',15,'D','O','U','B',
	6'L','E','P','R','E','C','I','S','I','O','N',7,'C','O','M',
	7'P','L','E','X',10,'S','U','B','R','O','U','T','I','N',
	8'E',8,'F','U','N','C','T','I','O','N',2,'D','O',3,'I','F',
	9'(',6,'W','R','I','T','E','(',5,'R','E','A','D','(',
	14,'G','O','T','O',4,'C','A','L','L',7,'D','E','C','O','D',
	2'E','(',7,'E','N','C','O','D','E','(',5,'F','I','N','D',
	3'(',6,'R','E','W','I','N','D',7,'E','N','D','F','I','L',
	4'E',9,'B','A','C','K','S','P','A','C','E',6,'A','S',
	5'S','I','G','N',6,'A','C','C','E','P','T',5,'P',
	6'R','I','N','T',7,'F','O','R','M','A','T','(',0/
C
C
C	CAPACIY IS 120 VARIABLE NAMES EACH WITH UP TO 30 REFERENCES EACH.
C	THE FORTRAN KEYWORDS AND CERTAIN OTHER SYSTAX ELEMENTS MUST
C	BE ENTIRELY CONTAINED ON THE FIRST (OR ONLY) LINE OF THE
C	STATEMENT TO BE PROPERLY RECOGNIZED, EXCEPT FOR
C	STATEMENTS FOLLOWING LOGICAL IF()S AND GO TO S.
C	VARIABLES BOTH IMMEDIATELY PRECEEDED AND FOLLOWED BY DOTTED KEYWORDS
C	AND CONSISTING OF 2-5 CHARACTERS WILL NOT BE XREFED.
C	VARIABLES TO THE RIGHT OF A LITERAL'!' IN DATA STATEMENTS MAY
C	NOT BE XREFED.
C	VARIABLE NAMES >6 CHARACTERS LONG WILL NOT BE XREFED CORRECTLY.
C	IN DATA STATEMENTS, A LITERAL '/' WILL CONFUSE THE SCAN FOR THE REST
C	OF THAT LINE.
C	ASSIGNMENT STATEMENTS WITH 'TYPE','PRINT','ACCEPT',
C	OR 'DO' ON THE LEFT OF THE "=" WILL HAVE THESE
C	VARIABLES TREATED AS KEYWORDS.
C	'READ LUN,LIST' STATEMENTS WILL NOT BE XREFED UNLESS THE LIST
C	CONTAINS A "=", IN WHICH CASE THEY WILL BE TREATED AS ARITHMETIC
C	ASSIGNMENTS AND XREFED INCORRECTLY.
C	'STOP' AND 'PAUSE' STATEMENTS THAT INCLUDE A DISPLAY CONTAINING
C	A "=" WILL BE TREATED AS CONTAINING VARIABLE NAMES
C	DEBUG (D) LINES ARE TREATED AS COMMENTS UNLESS /D SWITCH IS USED
C	INAME,NAME,NUMBER,COUNT AND 1 STATEMENT MUST BE CHANGED TO 
C	CHANGE THE CAPACITY (AND SIZE) OF THIS PROGRAM.
C
C
	TAB="11
	ITYPE=99
	LINEN=60
	NUM=0
	FFEED="14
	FLAG=.FALSE.
	EXTRA=.FALSE.
	LOST=.FALSE.
	DONE=.FALSE.
C
C--READ FIRST LINE AND LOOK FOR HEADER ("C** ") IN COL 1-4
C
2	READ (2,4,END=102,ERR=102) IQ,LINE
4	FORMAT (Q,80A1)
	IF (IQ .EQ. 0) GO TO 2
C
	DO 6 I=1,4
	IF (LINE(I) .NE. HEAD(I)) GO TO 10
6	CONTINUE
C
	CALL MOVEB (LINE,2,73,HEADER,2)			!SAVE THE HEADER
C
C============================== READ A LINE ========
C
8	CONTINUE
	READ (2,4,END=102,ERR=102) IQ,LINE
	IF(IQ .EQ. 0) GO TO 8
10	ICON=.TRUE.
	JSTART=0
C
C--IF A COMMENT LINE, JUST GO PRINT IT
C
	IF (LINE(1) .EQ. FFEED) GO TO 8
	IF (LINE(1) .EQ. IC) GO TO 90
	IF (.NOT. DEBUG .AND. LINE(1) .EQ. ID) GO TO 90
C
C--LOOK FOR CONTINUATION LINES, 
C
	ICON=.FALSE.
	DO 12 ICOL=1,6
	IF (LINE(ICOL) .EQ. TAB) GO TO 14
12	CONTINUE
C
C--NO TAB, SO CHECK COL 6  FOR 0 OR BLANK
C
	ICOL=7
	IF (LINE(6) .NE. IZERO .AND. LINE(6) .NE. NBLK) ICON=.TRUE.
	GO TO 16
C
C--TAB FOUND, SO NEXT CHAR = NON ALPHABETIC = CONTINUATION LINE
C
14	ICOL=ICOL+1
	IF (LINE (ICOL) .GT. "40 .AND. LINE(ICOL) .LT. "101) 
	1ICON=.TRUE.
C
	IF (ICON) ICOL=ICOL+1
16	IF (.NOT. ICON) NUM=NUM+1
	NUMX=NUM
	IF (ICON .AND. ITYPE .GE. 30) GO TO 90
	IF (.NOT. ICON) GO TO 22
C
C==========SET UP CONTINUATION LINES
C
C--MOVE LEFTWARD LOOKING FOR SPECIAL CHAR AT END OF LAST LINE
C
	DO 18 I=IEND,MCOL,-1
	IF (PACK(I) .LT. "60 .OR. PACK(I) .GT. "132) GO TO 22
	IF (PACK(I) .LT. "101 .AND. PACK(I) .GT. "71) GO TO 22
18	CONTINUE
C
C--IF END OF OLD LINE TERMINATED A VARIABLE NAME, IT MAY BE CONTINUED
C--ON THIS NEW LINE, SO
C--MOVE THE ALFA CHAR FOUND FROM END OF LAST LINE,TO START OF NEW LINE
C
	J=I+1
	DO 20 I=J,IEND
	JSTART=JSTART+1
	PACK(JSTART)=PACK(I)
20	CONTINUE
C
C--ELEMINATE THE VARIABLE NAME FOUND AT END OF LAST LINE, IT'S GARBAGE
C
	IF (NEW) ICOUNT=ICOUNT-1
	COUNT(JSAVE)=COUNT(JSAVE)-1
C
C==PACK REST OF LINE FOR ANALYSIS, DELETING BLANKS AND CONTROL CHARACTER
C     STOP WHEN A '!' (COMMENT), END OF LINE OR COL 72 IS FOUND
C
22	IEND=JSTART
	MCOL=1
	NEW=.FALSE.
	J=IQ
	IF (IQ .GT. 72) J=72
	DO 24 I=ICOL,J
	IF (LINE(I) .LE. NBLK) GO TO 24
	IF (LINE(I) .EQ. LEXPT .AND. LINE(I-1) .NE. HYF) GO TO 26
	IEND=IEND+1
	PACK(IEND)=LINE(I)
24	CONTINUE
26	PACK(IEND+1)=LEXPT
	ICOL=0
D	WRITE (6,998) PACK
D998	FORMAT (/1X,78A1)
	M=1
	IF (ICON .AND. ITYPE .EQ. 16 .AND. NX .GT. 0) GO TO 58
	IF (ICON .AND. ITYPE .EQ. 16 .AND. NX .EQ. 0) GO TO 30
	IF (ICON) GO TO 64
	DO 28 I=1,4
	IF (PACK(I) .NE. END(I)) GO TO 32
28	CONTINUE
	DONE=.TRUE.
	GO TO 90
C
C--RESOLVE TYPE OF IF() THAT ENDED AT END OF PREVIOUS LINE, IF
C--ARITHMETIC, JUST GO PRINT THIS LINE
C
30	CONTINUE
	IF (.NOT. FLAG) GO TO 32
	FLAG=.FALSE.
	IF (PACK(JSTART+1) .LT. "101) GO TO 90
	EXTRA=.TRUE.
C
C======================= FIND TYPE OF STATEMENT ==========
C
32	CONTINUE
	ISTART=1
34	ITYPE=0
	IF (EXTRA) NUM=NUM+1
	EXTRA=.FALSE.
	JEND=0
	INSID=.FALSE.
	INSIDE=.FALSE.
	NX=0
C
C--SKIP THIS SECTION IF LINE IS TOO SHORT TO CONTAIN A KEYWORD
C
	IF (IEND-ISTART .LE. 3) GO TO 40
	L=0
36	M=L+2
	IF (KEYWD(L+1) .EQ. 0) GO TO 40
	L=KEYWD(L+1)+M-1
	ITYPE=ITYPE+1
	ICOL=ISTART
D	WRITE (6,996) (KEYWD(NN),NN=M,L)
D996	FORMAT (1X,20A1)
	DO 38 I=M,L
	IF (PACK(ICOL) .NE. KEYWD(I)) GO TO 36
	ICOL=ICOL+1
38	CONTINUE
C
	ICOL=ICOL-1			!FOUND A MATCH
	GO TO 44
C
C--NOT FOUND IN KEYWD, IS IT AN ARITHMENTIC ASSIGNMENT??
C
40	CONTINUE
	ICOL=ISTART-1
	ITYPE=0
	DO 42 I=ISTART,IEND		!LOOK FOR "="
	IF (PACK(I) .EQ. IEQ) GO TO 64
42	CONTINUE
C
C--OK, FOUND A STATEMENT THAT CAN'T CONTAIN VARIABLES, JUST PRINT IT
C
	ITYPE=31
	GO TO 90
C
C============================SPECIAL PROCESSING
C
44	CONTINUE
	IF (ITYPE .EQ. 30) GO TO 90			!SKIP FORMATS
C
C--CHECK INTEGER, REAL, COMPLEX KEYWORDS TO SEE IF THEY ARE FUNCTIONS
C
	IF (ITYPE .NE. 6 .AND. ITYPE .NE. 7 .AND. ITYPE .NE. 12)
	1GO TO 48
	KCOL=ICOL
	DO 46 I=117,124
	KCOL=KCOL+1
	IF (PACK(KCOL) .NE. KEYWD(I)) GO TO 64
46	CONTINUE
	ICOL =KCOL
	GO TO 64
C
C--DECIDE IF CERTAIN SHORT KEYWORDS ARE IN FACT VARIABLE NAMES
C
48	IF (ITYPE .NE. 3 .AND. ITYPE .NE. 7 .AND. ITYPE .NE. 19
	1 .AND. ITYPE .NE. 27) GO TO 56
	DO 50 I=ISTART+4,IEND				!LOOK FOR A "="
	IF (PACK(I) .EQ. IEQ) GO TO 54
50	CONTINUE
C
C--GET PAST THE 'TO' IN ASSIGN STATEMENTS
C
	IF (ITYPE .NE. 27) GO TO 64
	DO 52 ICOL=ISTART+6,IEND
	IF (PACK(ICOL) .EQ. IO) GO TO 64
52	CONTINUE
	GO TO 64
C
54	ITYPE =0			!FOUND ONE, ITS AN ASSIGNMENT 
	ICOL=ISTART-1
	GO TO 64
C
C--FIND START OF SECOND PART OF LOGICAL IF'S
C
56	IF (ITYPE .NE. 16) GO TO 64
	M=3
58	DO 60 I=M,IEND
	IF (PACK(I) .EQ. LPARN) NX=NX+1
	IF (PACK(I) .EQ. RPARN) NX=NX-1
	IF (NX .EQ. 0) GO TO 62
60	CONTINUE
	GO TO 64
C
C--FOUND END OF 'IF(XX)', NOW A ALFA CHAR MEANS IT'S LOGICAL IF()
C--IF THE IF() ENDS AT THE END OF THE LINE, THE TYPE OF IF() CANNOT
C--BE DEFINED UNTIL THE NEXT LINE IS READ, SO FLAG IT FOR SPECIAL CHECK.
C
62	IF (PACK(I+1) .EQ. LEXPT) FLAG=.TRUE.
	IF (PACK(I+1) .GT. "100) JEND=IEND
	IEND=I
C
C============================= SCAN FOR VARIABLE NAMES =========
C
64	CONTINUE
	JCOL=ICOL
66	ICOL=JCOL
68	ICOL=ICOL+1
	IF (ICOL .GT. IEND) GO TO 88
C
C--SPECIAL PROCESSING TO SKIP JUNK BETWEEN // IN DATA STATEMENTS
C
	IF (ITYPE .NE. 2) GO TO 70
	IF (PACK(ICOL) .EQ. SLASH) INSIDE=.NOT. INSIDE
	IF (INSIDE) GO TO 68
C
C--SPECIAL PROCESSING TO SKIP LITERAL STRINGS IN CALL STATEMENTS
C
70	IF (ITYPE .NE. 20) GO TO 72
	IF (PACK(ICOL) .EQ. HYF) INSID=.NOT. INSID
	IF (INSID) GO TO 68
C
C===LOOK FOR FIRST ALFA CHAR, TO START A VARIABLE NAME
C
72	IF (PACK(ICOL) .LT. "101 .OR. PACK(ICOL) .GT. "132) GO TO 68
	JCOL=ICOL
	N=ICOL+5
	M=ICOL+1
C
C=====LOOK FOR A SPECIAL CHAR TO TERMINATE THE VARIALBE NAME
C
	DO 74 I=M,N
	IF (PACK(I) .LT. "60 .OR. PACK(I) .GT. "132) GO TO 76
	IF (PACK(I) .LT. "101 .AND. PACK(I) .GT. "71) GO TO 76
	JCOL=JCOL+1
74	CONTINUE
C
C--FOUND ONE BETWEEN ICOL AND JCOL
C--CHECK IT, ELIMATING DOTTED KEYWORDS, LITERALS, END=,ERR=
C     AND THE U IN DEFINE FILES,
C
76	IF (PACK(ICOL-1) .EQ. DOT .AND. PACK(JCOL+1) .EQ. DOT .AND.
	1 JCOL-ICOL .NE. 0 .AND. JCOL-ICOL .NE. 5) GO TO 66
	IF (PACK(ICOL-1) .EQ. HYF .AND. PACK(JCOL+1) .EQ. HYF)GO TO 66
	IF (PACK(JCOL+1) .EQ. IEQ .AND. (ITYPE .EQ. 18 .OR. ITYPE .EQ.
	1 17) .AND. (JCOL-ICOL .EQ. 2) .AND. (PACK(ICOL) .EQ. IE))
	2 GO TO 66
	IF (ITYPE .EQ. 8 .AND. ICOL .EQ. JCOL .AND. PACK(ICOL) .EQ. IU)
	1GO TO 66
C
C--IT'S GOOD, MOVE TO A TEMP AREA AND PAD WITH BLANKS
C
	DO 78 I=2,6
78	HOLD(I)=NBLK
	CALL MOVEB (PACK,ICOL,JCOL,HOLD,1)
C
C--NOW LOOK FOR IT AMONG THE EXISTING NAMES
C
	IF (ICOUNT .EQ. 0) GO TO 84
	DO 82 I=1,ICOUNT
	DO 80 J=1,3
	IF (INAME(J,I) .NE. IHOLD(J)) GO TO 82
80	CONTINUE
C
C--FOUND IT, IF IT'S FULL, KEEP LOOKING
C
	IF (COUNT(I) .LT. 30) GO TO 86		!**CHANGE TO ADJUST CAPACITY
82	CONTINUE
C
C--COULD NOT FIND IT, SO ADD IT AT END
C
	IF (ICOUNT .LT. 120) GO TO 84		!**CHANGE TO ADJUST CAPACITY
	LOST=.TRUE.
	GO TO 66
C
C--ADD NEW VARIABLE NAME
C
84	ICOUNT=ICOUNT+1
	I=ICOUNT
	NEW=.TRUE.
	COUNT(I)=0
	CALL MOVEB (HOLD,1,6,NAME(1,I),1)
86	COUNT(I)=COUNT(I)+1
D	WRITE (6,999) ICOUNT,COUNT(I),NUM,HOLD
D999	FORMAT (3I9,6A1)
	JSAVE=I
	MCOL=ICOL
	NUMBER(I,COUNT(I))=NUM
	GO TO 66			!RESUME SEARCH
C
C--GO PROCESS THE LAST PART OF LOGICAL IF'S 
C
88	CONTINUE
	IF (JEND .EQ. 0) GO TO 90
	EXTRA=.TRUE.
	IF (JEND .EQ. IEND) GO TO 90	!FORGET IT IF IF TAKES FULL LINE
	ISTART=IEND+1
	IEND=JEND
	GO TO 34
C
C================================= PRINT THE SOURCE CODE
C
90	CONTINUE
	IF (.NOT. IPRINT) GO TO 100
	IF (LINEN .LT. 52) GO TO 94		!**ADJUST PAGE LENGTH HERE
	LINEN=3
	WRITE (6,92)HEADER
92	FORMAT (1H1/82A1/)
C
94	CONTINUE
	IF (.NOT. ICON) WRITE (6,96) NUMX,TAB,(LINE(I),I=1,IQ)
96	FORMAT (I6,A1,80A1)
	IF (ICON) WRITE (6,98) TAB,(LINE(I),I=1,IQ)
98	FORMAT (1X,A1,80A1)
	LINEN=LINEN+1
100	IF (.NOT. DONE) GO TO 8
C
102	CONTINUE
	WRITE (6,92)
	RETURN
C
	END
C** XREF2 ** SUBROUTINE TO SORT AND PRINT XREF LISTING *****
C
C
	SUBROUTINE XREF2
C
	DIMENSION IRB(120),ILB(120),IORD(120)
	LOGICAL*1 COUNT(120),HEADER(82),NAME(6,120),DEBUG,IPRINT
	LOGICAL*1 JPRINT,LOST
	COMMON ICOUNT,NUMBER(120,30),NAME,DEBUG,HEADER,COUNT,IPRINT,
	1JPRINT,LOST
C
C	NOTE: ADJUST SIZE OF IRB,ILB,IORD,NAME,COUNT AND NUMBER TO 
C	CHANGE VARIABLE CAPACITY (NOW 120 NAMES).
C
	LINEN=3
	WRITE (6,2) HEADER
2	FORMAT (82A1/)
	IF (LOST) WRITE (6,6)
C
C--SORT THE ARRAY
C
	CALL SORTB (NAME,6,ICOUNT,IORD,ILB,IRB)
C
C--PRINT THE NAMES AND NUMBERS IN IORD ORDER
C
	DO 12 I=1,ICOUNT
	IF (LINEN .LT. 51) GO TO 8		!**ADJUST PAGE LENGTH HERE
	LINEN=3
	WRITE (6,4) HEADER
4	FORMAT (1H1/82A1/)
	IF (LOST) WRITE (6,6)
6	FORMAT (20X,'***TOO MANY VARIABLES, SOME NOT XREFED***')
	IF (LOST) LINEN=LINEN+1
C
8	J=COUNT(IORD(I))
	WRITE (6,10) (NAME(N,IORD(I)),N=1,6),(NUMBER(IORD(I),N),
	1N=1,J)
10	FORMAT (/2X,6A1,' --',15I4/11X,15I4)		!FITS 72 COL
	IF (COUNT(IORD(I)) .GE. 15) LINEN=LINEN+1
	LINEN=LINEN+2
12	CONTINUE
C
	WRITE (6,14)			!CLEAR THE PRINTER A LITTLE
14	FORMAT (40(1H /))
	RETURN
	END
C** SORTB ** SUBROUTINE TO SORT  CHARACTER ARRAYS INTO ALPHABETIC ORDER
C                                  RT11/DOS
C
C
C--SORTS A1 CHAR ARRAYS INTO ALPHABETICAL ORDER. IT IS JUST LIKE 
C-----'SORTW' EXCEPT THAT THE ARRAY OF CHAR MUST BE LOGICAL*1 
C--ARRAY 'IN' CONTAINS THE CHARACTERS TO BE SORTED. 'IORD' IS RETURNED W
C---THE SUBSCRIPS OF 'IN' SORTED INTO ALPHABAETICAL ORDER. A TO Z TO
C----0 TO 9. ARRAYS 'ILB' AND 'IRB' ARE WORKING ARRAYS. ARRAY 'IN'
C-----CONTAINS 'M' RECORDS AND 'N' CHARACTERS EACH.
C---THE CONTENTS OF 'IN' ARE NOT CHANGED BY THIS SORT.
C---UPON COMPLETION, SEQUENTIAL ELEMENTS OF 'IORD' CONTAIN
C-----THE (SECOND) SUBSCRIPT OF 'IN' IN ALPABETICLY INCREASING
C-----ORDER.
C---THIS IS A "MONKEY PUZZLE TREE" SORT AND IS VERY FAST.
C
	SUBROUTINE SORTB (IN, N, M, IORD, IRB, ILB)
C
	DIMENSION ILB(M), IRB(M), IORD(M)
	LOGICAL*1 IN(N,M)
C
	ILB(1)=0
	IRB(1)=0
	DO 18 I=2,M
	ILB(I)=0
	IRB(I)=0
2	J=1
4	DO 6 L=1,N
	IF (IN(L,I) .NE. IN(L,J)) GO TO 8
6	CONTINUE
8	CONTINUE
	IF (IN(L,I) .GT. IN(L,J)) GO TO 14
10	IF (ILB(J) .EQ. 0) GO TO 12
	J=ILB(J)
	GO TO 4
12	IRB(I)=-J
	ILB(J)=I
	GO TO 18
14	IF (IRB(J) .LE. 0) GO TO 16
	J=IRB(J)
	GO TO 4
16	IRB(I)=IRB(J)
	IRB(J)=I
18	CONTINUE
C--NOW STRIP THE MONKY PUZZLE TREE
	L=1
20	J=1
	GO TO 24
22	J=ILB(J)
24	IF (ILB(J) .GT. 0) GO TO 22
26	IORD(L)=J
	L=L+1
28	IF (IRB(J)) 32, 34, 30
30	J=IRB(J)
	GO TO 24
32	J=-IRB(J)
	GO TO 26
34	RETURN
	END
C** HELPR SUBROUTINE FOR RENUM TO PROVIDE HELP ON TT: ******
C
C
	SUBROUTINE HELPR
C
	WRITE (5,2)
2	FORMAT ('0RENUM SWITCHES:'/'0/X  PRODUCE CROSS REFERENCE INDEX
	1 OF VARIABLE NAMES'/' /R  RE-STATEMENT NUMBER SOURCE CODE
	3 INTO OUTPUT FILE'/' /L  PRODUCE LISTING OF SOURCE
	4 CODE, ELSE JUST VARIABLE INDEX'/' /D  TREAT DEBUG 
	4LINES AS VALID CODE, ELSE AS COMMENTS'/' /H  WRITE THIS HELP ON
	5 THE TRMINAL'/'0COMMAND LINE:  *[OUT][,LIST]=IN1[,IN
	62...IN6][/SWITCHS]'/
	4' "C** " IN COL 1-4 OF 1ST LINE OF CODE MAKES IT A HEADER.'/
	1' TO CREATE AN OUTPUT FILE OF RENUMBERED CODE, YOU MUST 
	2SPECIFY'/' AN OUTPUT FILE. HOWEVER, IT''S NAME IS A DUMMY-THE
	3 OUTPUT FILES(S)'/' ALWAYS HAVE THE SAME NAME(S) AS THE ORIGINAL
	4 SOURCE CODE FILE(S).'/' MULTIPLE SOURCE MODULES IN
	5 A SINGLE INPUT FILE ARE NOT ALLOWED.'/
	6' DEFAULTS: DEVICE = DK:; LIST FILE EXTENSION = .LST; INPUT FILE
	7'/' EXTENSION = .FOR; SWITCHES = /X+/R (NOT /L OR /D)'/
	8' PROGRAMS BEING RENUMBERED MUST NOT HAVE STATEMENT NUMBERS
	9 EXTENDING'/' OVER THE END OF A LINE ONTO A CONTINUATION
	1 LINE.'/' THE USE OF FORTRAN KEYWORDS AS VARIABLE NAMES IS BEST
	2 AVOIDED.'/)
	RETURN
	END