C** RENUM2 ** SUBROUTINE TO RENUMBER PROGRAMS FOR RENUM
C
C
	SUBROUTINE RENUM2
C
	LOGICAL*1 LINE(134),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,LOST
	COMMON LINEN,MAXLIN,IPAGE,INC,IERROR,IBEGIN,ICOUNT,DEBUG,LOST,
	$ OLD(499),LINE,HOLD,PACK
	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/' '/TAB/"11/,FFEED/"14/
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	IN 2 YEARS OF HEAVY USE, RENUM HAS NEVER PRODUCED
C	A BAD RENUMBERED PROGRAM.
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 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 TRUNCATED TO COL 80 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
	IHOLD=0
	HOLD(1)=TAB
	HOLD(2)="52		!ASCII '*'=CONTINUATION
	IERROR=0
	FLAG=.FALSE.
C
C======================== READ EACH LINE OF SOURCE CODE
C
2	CONTINUE
	READ (1,4,END=92) IEND,LINE
4	FORMAT (Q,134A1)
	IF (IEND .EQ. 0) GO TO 2			!SKIP BLANK LINES
	IF (LINE(1) .EQ. FFEED) GO TO 80		!SKIP FORM FEEDS
	IF (IEND .GT. 80) IEND=80			!CHOP OFF LONG LINES
	IF (LINE(1) .EQ. IC) GO TO 84			!SKIP COMMENTS
	IF (LINE(1) .EQ. ID .AND. .NOT. DEBUG) GO TO 84	!DEBUG
C
C======================== CONTINUATION LINES
C
	ICON=.FALSE.
	CALL CHARB (1,LINE,1,6,TAB,ICOL)
	IF (ICOL .GT. 0) GO TO 6
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 10
C
C--TAB FOUND SO IF THE NEXT CHAR IS NUMERIC, ITS A CONTINUATION
C
6	ICOL=ICOL+1
	IF (LINE(ICOL) .GT. "40 .AND. LINE(ICOL) .LT. "101) ICON=.TRUE.
8	IF (ICON) ICOL=ICOL+1
C
C==========TAKE CARE OF HOLDOVER FROM LAST LINE
C
10	IF (IHOLD .EQ. 0) GO TO 16
	IF (ICON) GO TO 12
C
C--HOLD CAN'T BE PART OF THIS LINE SO CREATE A NEW CONTINUATION LINE
C
	WRITE (2,82) (HOLD(I),I=1,IHOLD)
	IHOLD=0
	GO TO 16
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
12	CONTINUE
	IDELT=JHOLD-2
	IEND=IEND+IDELT
	DO 14 I=IEND,ICOL,-1		!SHIFT 'LINE' BY IDELT CHAR
	LINE(I)=LINE(I-IDELT)
14	CONTINUE
C
	CALL MOVEB (HOLD,3,JHOLD,LINE,ICOL)		!MOVE HOLD INTO LINE
	ICOL=ICOL+(JHOLD-3+1)
	IHOLD=0
C
C=========PROCESS CONTINUATION LINES
C
16	CONTINUE
	ISTART=ICOL			!POINT TO START OF NEW LINE'S DATA
	IF (.NOT. ICON) GO TO 20		!NOT CONTINUATION
	IF (ITYPE .EQ. 0) GO TO 74		!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 18
	I=ICOL
	CALL BLANKB (1,LINE,I,LEND,ICOL)
	FLAG=.FALSE.
	IF (ICOL .LE. 0) GO TO 74
	IF (LINE(ICOL) .GT. "100) GO TO 22		!GO ANALYZE
	GO TO 70				!ARITHMETIC, GO CONVERT
C
18	IF (ITYPE .EQ. 3 .AND. NX .GT. 0) GO TO 62	!LOOK FOR ')'
	IF (ITYPE .EQ. 3 .AND. NX .EQ. 0) GO TO 70	!GO CONVERT
	IF (ITYPE .EQ. 5) GO TO 54			!CONTINUE GO TO'S
D	WRITE (6,24) ITYPE,(LINE(N),N=1,IEND)
D24	FORMAT (' WHAT?, ITYPE=',I4,1X,80A1)
	GO TO 86
C
C==========CONVERT STATEMENT NUMBER LABELS
C
20	IF (LINE(1) .EQ. TAB) GO TO 22		!CANNOT CONTAIN A STATE.NUM
	ISTART=1
	JEND=5					!DO ONLY LABEL FIELD
	XOLD=OLDNUM(LINE,JEND,ISTART,ISTOP)
	IF (XOLD .EQ. 0.) GO TO 22			!NONE FOUND
C
C--PUT NEW NUMBER IN PLACE OF THE OLD ONE
C
	NEW=NEWNUM(ICOUNT,OLD,XOLD)*INC+IBEGIN
	IF (NEW .EQ. 0) GO TO 88
	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
22	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
	CALL CHARB (1,TEST,1,9,LINE(ICOL),I)
	IF (I .LE. 0) GO TO 80
C
C--PACK PART OF 'LINE' FOR KEYWORD ANALYSIS
C
24	CONTINUE
	I=ICOL-1
	DO 28 J=1,7
26	I=I+1
	IF (LINE(I) .EQ. NBLK) GO TO 26		!DELETE BLANKS
	PACK(J)=LINE(I)
28	CONTINUE
D	WRITE (5,40) ICOL,PACK
D40	FORMAT (I7,1X,8A1)
C
	CALL COMPAR (KEYWD,PACK,1,JCOL,ITYPE)	!CHECK FOR KEYWORDS
	IF (ITYPE .EQ. 0) GO TO 86
	ISTART=ICOL+JCOL
	JCOL=JCOL+1
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 42
C
	CALL CHARB (1,LINE,ISTART-1,IEND,LPAREN,IFOUND)	!FIND START OF ()
	IF (IFOUND .LE. 0) GO TO 88
	I=0
	DO 30 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 32
30	CONTINUE
	GO TO 88
C
32	CALL CHARB (1,LINE,IFOUND+1,LEND,ICOMA,IFOUND)
	IF (IFOUND .LE. 0) GO TO 86		!CANNOT HAVE ANY NUMBERS
	CALL BLANKB(1,LINE,IFOUND+1,LEND,ISTOP)
	IF (ISTOP .LE. 0) GO TO 88
34	IF (LINE(ISTOP) .GT. "100) GO TO 38
36	ISTART=IFOUND+1
	ISTOP=ISTART
	XOLD=OLDNUM(LINE,LEND,ISTART,ISTOP)
	IF (XOLD .EQ. 0.) GO TO 38
	NEW=NEWNUM(ICOUNT,OLD,XOLD)*INC+IBEGIN
	IF (NEW .EQ. 0) GO TO 88
	I=IEND
	CALL PUTIT (LINE,IEND,ISTART,ISTOP,NEW,1)
	LEND=LEND-(I-IEND)			!ADJUST LEND
38	IF (ITYPE .GT. 2) GO TO 40		!DONE WITH ENCODE/DECODE
C
	CALL CHARB (1,LINE,ISTOP,LEND,IEQ,IFOUND)	!LOOK FOR 'END='
	IF (IFOUND .GT. 0) GO TO 36
40	ITYPE=0					!NO MORE NUMBERS
	GO TO 74
C
C-------PROCESS PRINT,ACCEPT,TYPE,READ AND ASSIGN STATEMENTS
C
42	IF (ITYPE .LT. 8) GO TO 48
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 86
C
	DO 44 JEND=ISTART,IEND		!FIND END OF USEFUL PART OF LINE
	IF (LINE(JEND) .EQ. ITO .AND. ITYPE .EQ. 8) GO TO 46
	IF (LINE(JEND) .EQ. ICOMA .AND. ITYPE .NE. 8) GO TO 46
44	CONTINUE
	JEND=IEND			!NO VARIABLE LIST
C
46	XOLD=OLDNUM(LINE,JEND,ISTART,ISTOP)
	IF (XOLD .EQ. 0.) GO TO 88		!SOMETHING WRONG
	NEW=NEWNUM(ICOUNT,OLD,XOLD)*INC+IBEGIN
	IF (NEW .EQ. 0) GO TO 88
	CALL PUTIT (LINE,IEND,ISTART,ISTOP,NEW,1)
	ITYPE=0
	GO TO 74
C
C------------PROCESS DO STATEMENTS
C
48	IF (ITYPE .NE. 4) GO TO 50
	IF (PACK(JCOL) .LT. "60 .OR. PACK(JCOL) .GT. "71) GO TO 86
	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 88
	GO TO 46
C
C-------------PROCESS GO TO'S
C
50	CALL CHARB(1,LINE,ISTART,IEND,LEXPT,LEND)	!FIND COMMENTS
	IF (LEND .LE. 0) LEND=IEND
	JEND=LEND
C
52	IF (ITYPE .NE. 5) GO TO 60
C
	IF (PACK(JCOL) .GE. "60 .AND. PACK(JCOL) .LE. "71) GO TO 58
	CALL CHARB (1,LINE,ISTART,LEND,LPAREN,ISTART)
	IF (ISTART .LE. 0) GO TO 86		!HAS NO STATEMENT NUMBERS
C
54	CALL CHARB (1,LINE,ISTART,LEND,RPAREN,JEND)
	IF (JEND .LE. 0) JEND=LEND
	ISTOP=ISTART-1
56	ISTART=ISTOP+1
58	XOLD=OLDNUM (LINE,JEND,ISTART,ISTOP)
	IF (XOLD .EQ. 0.) GO TO 74		!DONE WITH THIS LINE
	NEW=NEWNUM (ICOUNT, OLD,XOLD)*INC+IBEGIN
	IF (NEW .EQ. 0) GO TO 88
	I=IEND
	CALL PUTIT (LINE,IEND,ISTART,ISTOP,NEW,1)
	JEND=JEND-(I-IEND)		!ADJUST JEND
	LEND=LEND-(I-IEND)
	GO TO 56			!GO BACK FOR ANOTHER NUM ON THIS LINE
C
C------------PROCESS IF'S
C
60	CONTINUE
	CALL CHARB (1,LINE,ISTART-1,LEND,LPAREN,ICOL)
62	DO 64 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 66
64	CONTINUE
	GO TO 80			!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
66	CALL BLANKB (1,LINE,I+1,LEND,ICOL)
	IF (ICOL .GT. 0) GO TO 68
	FLAG=.TRUE.			!TYPE IS UNRESOLVABLE
	GO TO 80
C
68	CONTINUE
	IF (LINE (ICOL) .GT. "100) GO TO 22		!IT'S LOGICAL
	IF (LINE(ICOL) .LT. "60 .OR. LINE(ICOL) .GT. "71) GO TO 86
	ISTATE=1					!IT'S ARITHMETIC
	ISTART=ICOL
C
C--CONVERT 3 STATEMENT NUMBERS
C
70	DO 72 ISTATE=ISTATE,3			!WATCH THIS
	XOLD=OLDNUM(LINE,LEND,ISTART,ISTOP)
	IF (XOLD .EQ. 0.) GO TO 74
	NEW=NEWNUM(ICOUNT,OLD,XOLD)*INC+IBEGIN
	IF (NEW .EQ. 0) GO TO 88
	I=IEND
	CALL PUTIT (LINE,IEND,ISTART,ISTOP,NEW,1)
	LEND=LEND-(I-IEND)			!ADJUST LEND
	ISTART=ISTOP+1
72	CONTINUE
C
	ITYPE=0
C
C==================== WRITE THIS LINE OUT INTO NEW FILE
C
74	CONTINUE
	IF (IEND .LE. 72) GO TO 80
C
C--DECIDE WHAT TO DO ABOUT POSSIBLE END-OF-LINE COMMENTS
C
	IF (ITYPE .EQ. 3 .OR. ITYPE .EQ. 5) GO TO 76		!THEY KNOW LEND ALREADY
	CALL CHARB (1,LINE,ISTART,IEND,LEXPT,LEND)
	IF (LEND .GT. 0) GO TO 76
	LEND=IEND			!NO COMMENTS 
	GO TO 78
C
C--GOT COMMENTS, IF EXCESS OVER 72 IS ALL COMMENTS, CHOP IT OFF
C
76	IF (LEND .GT. 72) GO TO 78
	IEND=MIN0(80,IEND)
	GO TO 80
C
C--SAVE THE EXCESS FOR THE NEXT LINE
C
78	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,90)
C
80	CONTINUE
	WRITE (2,82) (LINE(I),I=1,IEND)		!WRITE THIS LINE
82	FORMAT (120A1)
	GO TO 2					!GET NEXT LINE
C
84	CONTINUE
	IF (IHOLD .GT. 0) WRITE (6,82)(HOLD(N),N=1,IHOLD)
	IHOLD=0
86	CONTINUE				!RESET ITYPE AND PRINT
	ITYPE=0
	GO TO 80
C
88	CONTINUE				!FLAG ERRORS
	WRITE (2,90) 
90	FORMAT ('C?????POSSIBLE STATEMENT NUMBER CONVERSION ERROR
	1 IN FOLLOWING STATEMENT??????')
	IERROR=IERROR+1
	ITYPE=0
	GO TO 74
C
92	CONTINUE			!DONE
	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,94,HOLD) NEW
94	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 96
	ISTART=1
	IF (LINE(1) .EQ. ID) ISTART=2		!ALLOW FOR DEBUG
	ISTOP=5
	GO TO 104				!NO SHIFTING ALOWED
C
C--FIND NUMBER OF CHARACTERS IN THE NUMBER
C
96	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 104
	IDELT=J-I
	IEND=IEND-IDELT
	ISTOP=ISTOP-IDELT
	IF (J .LT. I) GO TO 100
C
C--SHIFT REST OF LINE TO THE LEFT (LEAVES GARBAGE TO RIGHT OF 'IEND')
C
	DO 98 ICOL=ISTART+I,IEND
	LINE(ICOL)=LINE(ICOL+IDELT)
98	CONTINUE
	GO TO 104
C
C--SHIFT REST OF LINE TO THE RIGHT TO MAKE ROOM
C
100	DO 102 ICOL=IEND,ISTART+I,-1
	LINE(ICOL)=LINE(ICOL+IDELT)		!IDELT <0
102	CONTINUE
C
C--MOVE THE NEW STATEMENT NUMBER INTO THE SPACE IN 'LINE'
C
104	I=5
	DO 106 J=ISTOP,ISTART,-1
	LINE(J)=HOLD(I)
	I=I-1
106	CONTINUE
D	WRITE (6,16) NEW
D16	FORMAT (' PUT ',I5)
C
	RETURN
C
	END
C** NEWNUM ** FUNCTION FOR RENUM TO GET THE EQUIVALENT NEW STATE.NUM
C
C
	FUNCTION NEWNUM (ICOUNT,OLD,OLDNUM)
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 - AFTER RETURN
C	IT WILL BE MULTIPLIED BY 'INC' AND OFFSET BY 'IBEGIN'.
C
D	WRITE (5,2) ICOUNT,(OLD(N),N=1,10)
D2	FORMAT (I6,10F6.0)
	DO 108 NEWNUM=1,ICOUNT
	IF (OLD(NEWNUM) .EQ. OLDNUM) RETURN
108	CONTINUE
C
	NEWNUM=0
	RETURN
C
	END