C** XREF1 ** SUBROUTINE TO PREPARE A CROSS REFERENCE LISTING
C
C
	SUBROUTINE XREF1
C
	DIMENSION IHOLD(3),INAME(3,140),DOS(13)
	LOGICAL*1 ICON,FFEED,IC,IEQ,DOT,HYF,HOLD(6),EXTRA,LEXPT,LCOM
	LOGICAL*1 COUNT(140),HEADER(106),NAME(6,140),FLAG,DEBUG,ID
	LOGICAL*1 LOST,INSIDE,SLASH,INSID,COMA
	LOGICAL*1 TEST(57),DONE,FIRST
	LOGICAL*1 LINE(134),PACK(78),KEYWD(277),TAB,NBLK,HEAD(4)
	LOGICAL*1 IE,LPARN,RPARN,IPRINT,JPRINT,IZERO,NEW,IU,IO
	COMMON LINEN,MAXLIN,IPAGE,INC,IERROR,IBEGIN,ICOUNT,DEBUG,LOST,
	1 NUMBER(140,30),NAME,HEADER,COUNT,IPRINT,JPRINT
	EQUIVALENCE (IHOLD,HOLD),(INAME,NAME)
	DATA NBLK/' '/,IC/'C'/,IEQ/'='/,DOT/'.'/,IZERO/'0'/,SLASH/'/'/
	DATA HEAD/'C',2*'*',' '/,HYF/''''/,IE/'E'/,COMA/','/
	DATA LPARN/'('/,RPARN/')'/,LEXPT/'!'/,ID/'D'/,IU/'U'/,IO/'O'/
	DATA TAB/"11/,FFEED/"14/
C
	DATA TEST/3,'E','Q','.',3,'L','T','.',3,'G','T','.',
	13,'L','E','.',3,'G','E','.',3,'O','R','.',3,'N','E','.',
	24,'A','N','D','.',4,'N','O','T','.',4,'X','O','R','.',5,'T',
	3'R','U','E','.',6,'F','A','L','S','E','.',0/
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','(',4,'B',
	7'Y','T','E',4,'E','N','D','!',5,'E','N','T','R','Y',
	85,'O','P','E','N','(',6,'C','L','O','S','E','(',
	97,'I','N','C','L','U','D','E',9,'P','A','R','A','M','E',
	1'T','E','R',0/
C
C
C	CAPACIY IS 140 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
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	F4P'S OPEN AND CLOSE STATEMENTS WILL BE XREFED STRANGLEY.
C	VARIABLS USED IN VARIABLE FIELD WIDTH EXPRESSIONS IN FORMAT
C	 STATEMENTS WILL NOT BE XREFED.
C	OTHER ODDBALL AND UNWISE BUT LEGAL CONSTRUCTIONS MAY ALSO
C	CAUSE STRANGE ERRORS.
C	DEBUG (D) LINES ARE TREATED AS COMMENTS UNLESS /NODE 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------VERSION 2, JAN 76, ADDS DOTTED KEYWORD SIVE
C------VERSION 3, MAR 76, CHANGES HANDLING OF FORM FEEDS
C------VERSION 4, MAY 76, ADDS FLAGGING OF DO LOOPS,PAGE FORMATTING
C------VERSION 5, FEB77, ADDS F4P SPECIFIC KEYWORDS
C
	ITYPE=99
	LUNOUT=3
	LINEN=99
	NUMDO=0		!COUNT OF CURRENTLY PENDING DO LOOPS
	NUM=0
	FLAG=.FALSE.
	FIRST=.TRUE.
	EXTRA=.FALSE.
	LOST=.FALSE.
	DONE=.FALSE.
C
C============================== READ A LINE ========
C
2	READ (2,4,END=114,ERR=116) IQ,LINE
4	FORMAT (Q,134A1)
	IF (IQ .EQ. 0) GO TO 2
	IF (IQ .GT. 80) IQ=80			!TRUNCATE LONG LINES
	IF(LINE(1) .EQ. FFEED)GO TO 2			!SKIP  FF
	IF (.NOT. FIRST) GO TO 8
C
C-- FIRST LINE, LOOK FOR HEADER ("C** ") IN COL 1-4
C
	DO 6 I=1,4
	IF (LINE(I) .NE. HEAD(I)) GO TO 8
6	CONTINUE
	CALL MOVEB (LINE,2,80,HEADER,2)			!SAVE THE HEADER
	FIRST=.FALSE.
	GO TO 2
C
C
8	ICON=.TRUE.
	LCOM=.TRUE.
	JSTART=0
	FIRST=.FALSE.
C
C--IF A COMMENT LINE, JUST GO PRINT IT
C
	IF (LINE(1) .EQ. IC) GO TO 82
	IF (.NOT. DEBUG .AND. LINE(1) .EQ. ID) GO TO 82
C
C--LOOK FOR CONTINUATION LINES, 
C
	LCOM=.FALSE.
	ICON=.FALSE.
	CALL CHARB (1,LINE,1,6,TAB,ICOL)	!FIND A TAB
	IF (ICOL .GT. 0) GO TO 10		!FOUND ONE
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 12
C
C--TAB FOUND, SO NEXT CHAR = NON ALPHABETIC = CONTINUATION LINE
C
10	ICOL=ICOL+1
	IF (LINE (ICOL) .GT. "40 .AND. LINE(ICOL) .LT. "101) 
	1ICON=.TRUE.
C
	IF (ICON) ICOL=ICOL+1
12	IF (.NOT. ICON) NUM=NUM+1
	NUMX=NUM
	IF (ICON .AND. (ITYPE .EQ. 30 .OR. ITYPE .EQ. 99)) GO TO 82
	IF (.NOT. ICON) GO TO 16
C
C==========SET UP CONTINUATION LINES
C
C--MOVE LEFTWARD LOOKING FOR SPECIAL CHAR AT END OF LAST LINE
C
	DO 14 I=IEND,MCOL,-1
	IF (PACK(I) .LT. "60 .OR. PACK(I) .GT. "132) GO TO 16
	IF (PACK(I) .LT. "101 .AND. PACK(I) .GT. "71) GO TO 16
14	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
	CALL MOVEB (PACK,I+1,IEND,PACK,JSTART+1)
	JSTART=JSTART+(IEND-I)
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
16	IEND=JSTART
	MCOL=1
	NEW=.FALSE.
	J=IQ
	IF (IQ .GT. 72) J=72
	DO 18 I=ICOL,J
	IF (LINE(I) .LE. NBLK) GO TO 18
	IF (LINE(I) .EQ. LEXPT .AND. LINE(I-1) .NE. HYF) GO TO 20
	IEND=IEND+1
	PACK(IEND)=LINE(I)
18	CONTINUE
20	PACK(IEND+1)=LEXPT
	ICOL=0
D	WRITE (LUNOUT,22) PACK
D22	FORMAT (/1X,78A1)
	M=1
	IF (ICON .AND. ITYPE .EQ. 16 .AND. NX .GT. 0) GO TO 44
	IF (ICON .AND. ITYPE .EQ. 16 .AND. NX .EQ. 0) GO TO 24
	IF (ICON) GO TO 50
C
C--RESOLVE TYPE OF IF() THAT ENDED AT END OF PREVIOUS LINE, IF
C--ARITHMETIC, JUST GO PRINT THIS LINE
C
24	CONTINUE
	IF (.NOT. FLAG) GO TO 26
	FLAG=.FALSE.
	IF (PACK(JSTART+1) .LT. "101) GO TO 82		!ARITHMETIC
	EXTRA=.TRUE.
C
C======================= FIND TYPE OF STATEMENT ==========
C
26	CONTINUE
	ISTART=1
28	IF (EXTRA) NUM=NUM+1
	EXTRA=.FALSE.
	JEND=0
	INSID=.FALSE.
	INSIDE=.FALSE.
	NX=0
C
C****CHECK TO SEE IF LINE STARTS WITH A FORTRAN KEYWORD
C
	CALL COMPAR (KEYWD,PACK,ISTART,ICOL,ITYPE)
	IF (ITYPE .GT. 0) GO TO 34			!GOT ONE
C
C--NOT FOUND IN KEYWD, IS IT AN ARITHMENTIC ASSIGNMENT??
C
30	CONTINUE
	CALL CHARB (1,PACK,ISTART,IEND,IEQ,I)		!LOOK FOR =
32	ICOL=ISTART-1
	ITYPE=0
	IF (I .GT. 0) GO TO 50				!FOUND ONE
C
C--OK, FOUND A STATEMENT THAT CAN'T CONTAIN VARIABLES, JUST PRINT IT
C
	ITYPE=99
	GO TO 82
C
C============================SPECIAL PROCESSING
C
34	CONTINUE
	IF (ITYPE .EQ. 30 .OR. ITYPE .EQ. 32 .OR. ITYPE .EQ. 34 .OR.
	1 ITYPE .EQ. 35) GO TO 82			!SKIP FORMAT,END,OPEN,CLOSE
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
	1 .AND. ITYPE .NE. 5) GO TO 38
	KCOL=ICOL
	DO 36 I=117,124
	KCOL=KCOL+1
	IF (PACK(KCOL) .NE. KEYWD(I)) GO TO 50
36	CONTINUE
	ICOL =KCOL
	GO TO 50
C
C--DOUBLE CHECK DO LOOPS
C
38	IF (ITYPE .NE. 15) GO TO 40
C
	I=999						!FLAG FOR GO TO
	CALL CHARB(1,PACK,ICOL,IEND,IEQ,J)	!LOOK FOR =
	IF (J .LE. 0) GO TO 32			!CANNOT BE A DO
	CALL CHARB(1,PACK,J,IEND,COMA,J)	!LOOK FOR ,
	IF (J .LE. 0) GO TO 32		!CANNOT BE A DO
	IF (NUMDO .EQ. 13) GO TO 50	!SKIP IF >13 NESTED DO'S
	J=ICOL+1
	IF (PACK(J) .LT. "60 .OR. PACK(J) .GT. "71) GO TO 32	!MUST BE DIGIT
	X=OLDNUM(PACK,IEND,J,M)
	IF (X .EQ. 0.) GO TO 32		!NO NUMBER AFTER THE 'DO'
	NUMDO=NUMDO+1			!COUNT PENDING DO'S
	DOS(NUMDO)=X			!REMEMBER TERMINATING STATMENT
	GO TO 50			!ASSUME IT'S A DO
C
C--DECIDE IF CERTAIN SHORT KEYWORDS ARE IN FACT VARIABLE NAMES
C
40	IF (ITYPE .NE. 3 .AND. ITYPE .NE. 7 .AND. ITYPE .NE. 19
	1 .AND. ITYPE .NE. 27 .AND. ITYPE .NE. 31) GO TO 42
	CALL CHARB (1,PACK,ISTART+4,IEND,IEQ,I)		!LOOK FOR =
	IF (I .GT. 0) GO TO 32				!FOUND ONE
C
C--GET PAST THE 'TO' IN ASSIGN STATEMENTS
C
	IF (ITYPE .NE. 27) GO TO 50
	CALL CHARB (1,PACK,ISTART+6,IEND,IO,ICOL)
	IF (ICOL .GT. 0) GO TO 50			!GOT IT
	I=999
	GO TO 32
C
C--FIND START OF SECOND PART OF LOGICAL IF'S
C
42	IF (ITYPE .NE. 16) GO TO 50
	M=3
44	DO 46 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 48
46	CONTINUE
	GO TO 50
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
48	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
50	CONTINUE
	JCOL=ICOL
52	ICOL=JCOL
54	ICOL=ICOL+1
	IF (ICOL .GT. IEND) GO TO 80
C
C--SPECIAL PROCESSING TO SKIP JUNK BETWEEN // IN DATA STATEMENTS
C
	IF (ITYPE .NE. 2) GO TO 56
	IF (PACK(ICOL) .EQ. SLASH) INSIDE=.NOT. INSIDE
	IF (INSIDE) GO TO 54
C
C--SPECIAL PROCESSING TO SKIP LITERAL STRINGS IN CALL STATEMENTS
C
56	IF (ITYPE .NE. 20) GO TO 58
	IF (PACK(ICOL) .EQ. HYF) INSID=.NOT. INSID
	IF (INSID) GO TO 54
C
C===LOOK FOR FIRST ALFA CHAR, TO START A VARIABLE NAME
C
58	IF (PACK(ICOL) .LT. "101 .OR. PACK(ICOL) .GT. "132) GO TO 54
	JCOL=ICOL
	N=ICOL+5
	M=ICOL+1
C
C=====LOOK FOR A SPECIAL CHAR TO TERMINATE THE VARIALBE NAME
C
	DO 60 I=M,N
	IF (PACK(I) .LT. "60 .OR. PACK(I) .GT. "132) GO TO 62
	IF (PACK(I) .LT. "101 .AND. PACK(I) .GT. "71) GO TO 62
	JCOL=JCOL+1
60	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
62	IF (PACK(ICOL-1) .EQ. DOT .AND. PACK(JCOL+1) .EQ. DOT)GO TO 64
	IF (PACK(ICOL-1) .EQ. HYF .AND. PACK(JCOL+1) .EQ. HYF)GO TO 52
	IF (PACK(JCOL+1) .EQ. IEQ .AND. (ITYPE .EQ. 18 .OR. ITYPE .EQ.
	1 17 .OR. ITYPE .EQ. 21 .OR. ITYPE .EQ. 22) .AND.
	1 (JCOL-ICOL .EQ. 2) .AND. (PACK(ICOL) .EQ. IE)) GO TO 52
	IF (ITYPE .EQ. 8 .AND. ICOL .EQ. JCOL .AND. PACK(ICOL) .EQ. IU)
	1GO TO 52
	GO TO 66
C
C--CHECK CAREFULLY TO THROW AWAY DOTTED KEYWORDS
C
64	CALL COMPAR (TEST,PACK,ICOL,I,JTYPE)
	IF (JTYPE .NE. 0) GO TO 52		!A LOGICAL OPERATOR, SKIP IT
C
C--IT'S GOOD, MOVE TO A TEMP AREA AND PAD WITH BLANKS
C
66	DO 68 I=2,6
68	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 74
	DO 72 I=1,ICOUNT
	DO 70 J=1,3
	IF (INAME(J,I) .NE. IHOLD(J)) GO TO 72
70	CONTINUE
C
C--FOUND IT, IF IT'S FULL, KEEP LOOKING
C
	IF (COUNT(I) .LT. 30) GO TO 76		!**CHANGE TO ADJUST CAPACITY
72	CONTINUE
C
C--COULD NOT FIND IT, SO ADD IT AT END
C
	IF (ICOUNT .LT. 140) GO TO 74		!**CHANGE TO ADJUST CAPACITY
	LOST=.TRUE.
	GO TO 52
C
C--ADD NEW VARIABLE NAME
C
74	ICOUNT=ICOUNT+1
	I=ICOUNT
	NEW=.TRUE.
	COUNT(I)=0
	CALL MOVEB (HOLD,1,6,NAME(1,I),1)
76	COUNT(I)=COUNT(I)+1
D	WRITE (LUNOUT,78) ICOUNT,COUNT(I),NUM,HOLD
D78	FORMAT (3I9,6A1)
	JSAVE=I
	MCOL=ICOL
	NUMBER(I,COUNT(I))=NUM
	GO TO 52			!RESUME SEARCH
C
C--GO PROCESS THE LAST PART OF LOGICAL IF'S 
C
80	CONTINUE
	IF (JEND .EQ. 0) GO TO 82		!DIDN'T FIND END OF IF()
	EXTRA=.TRUE.			!FOUND END
	IF (JEND .EQ. IEND) GO TO 82	!FORGET IT IF IF TAKES FULL LINE
	ISTART=IEND+1
	IEND=JEND
	GO TO 28
C
C================================= PRINT THE SOURCE CODE
C
82	CONTINUE
	IF (.NOT. IPRINT) GO TO 106
	IF (LINEN .LT. MAXLIN) GO TO 92
	IF (ITYPE .EQ. 32) GO TO 92		!ALLOW 1 EXTRA LINE
84	IF (LINEN .LT. 9999 .AND. IPRINT) WRITE (LUNOUT,86)
86	FORMAT (1H1)
C
88	LINEN=4
	WRITE (LUNOUT,90)HEADER,IPAGE
90	FORMAT (/106A1,I4,' **'/)
	IPAGE=IPAGE+1
C
92	CONTINUE
	IF (NUMDO .GT. 0) WRITE (LUNOUT,94) (HEAD(2),I=1,NUMDO)
94	FORMAT ('$',T14,' ',T2,13A1)
	IF (NUMDO .LE. 0) WRITE (LUNOUT,96)
96	FORMAT ('$',T14,' ')
	IF (.NOT. ICON) WRITE (LUNOUT,98) NUMX,TAB,(LINE(I),I=1,IQ)
98	FORMAT ('+',I4,100A1)
	IF (.NOT. ICON) GO TO 104
	IF (LCOM) WRITE (LUNOUT,100) TAB,(LINE(I),I=1,IQ)
100	FORMAT ('+',A1,'  >>',80A1)
	IF (.NOT. LCOM) WRITE (LUNOUT,102) TAB,TAB,(LINE(I),I=1,IQ)
102	FORMAT ('+',80A1)
104	LINEN=LINEN+1
C
	IF (ITYPE .NE. 32) GO TO 106		!ON 'END', ADVANCE PAGE
	WRITE (LUNOUT,86)
	FIRST=.TRUE.			!LOOK FOR C** ON NEXT LINE
	LINEN=9999			!FLAG THIS ODD STATUS
	ITYPE=0
C
C
C--IF THIS LINE HAS A STATEMENT NUMBER WHICH IS ONE OF THE
C	TERMINATORS OF ONE OR MORE OF THE OUTSTANDING DO LOOPS,
C	REMOVE IT FROM DOS AND REDUCE THE NUMBER OF OUTSTANDING
C	DOS ACCORDINGLY.
C
106	CONTINUE
	IF (NUMDO .EQ. 0) GO TO 112
	N=1
	X=OLDNUM(LINE,5,N,M)		!LOOK FOR A NUMBER ON THIS LINE
	IF (X .LE. 0.) GO TO 112		!CAN'T BE END OF DO LOOP WITHOUT NUMBER
	J=NUMDO
	DO 110 I=1,J			!SEARCH VECTOR AND PACK
108	IF (DOS(I) .NE. X) GO TO 110
	DOS(I)=DOS(NUMDO)
	DOS(NUMDO)=0.
	NUMDO=NUMDO-1
	GO TO 108
110	CONTINUE
C
112	IF (.NOT. DONE) GO TO 2
C
114	IF (LINEN .LT. 9999) WRITE (LUNOUT,86)		!OVERLAP SORT&PAGE ADVANCE
	RETURN
C
116	STOP '*ABORT--HARDWARE READ ERROR IN INPUT FILE*'
C
	END