SUBROUTINE XREF
C
      IMPLICIT LOGICAL*1 (B)
      DOUBLE PRECISION SYMBOL
      COMMON/PARAMS/LUNIN,LUNOUT,LUNCMD,BTAB,BSPC,NLINE,NSTMT,
     1ICLASS,BCHR,BLST,JSYM(2),NSYMTP,IPARNS,NPAGE,NLIST
      COMMON /INBUFR/INSIZ,INCNT,IOUTX,MCRSIZ,INFIL,IOUTFL,
     1BDPB(2),BUFR(80),BNAM(24),BTIME(8),BDATE(9),BX(1)
      COMMON NSYM,NELM,KLIM,SYMBOL(2000)
C
	EXTERNAL NXTCHR,NXTSYM
	DATA I5ERR/3RERR/,I5END/3REND/
C
    1 JSYM(1)=0
      JSYM(2)=0
      IPARNS=0			!INIT PAREN COUNTER
	IF(NELM.EQ.0)GOTO 99	!SYMBOL TABLE OVERFLOW
C
C     READ INPUT DATA LOOKING FOR STATEMENT NUMBER AND
C ... POSITION INPUT BUFFER AT FIRST CHAR OF STATEMENT
C
      ICLASS=0
      DO 10 I=1,5
      BCHR=NXTCHR(IOUTX)
      IF (BCHR.EQ.0) GO TO 99  !PREMATURE END-OF-FILE
      GO TO (96,5,10,96,15),ITSTCH(BCHR)  !DISPATCH ON CHARACTER TYPE
    5 JSYM(2)=(JSYM(2)*10)+(BCHR-"60)  !COMPUTE STATEMENT NUMBER
   10 CONTINUE
C *** CK IF WE GOT A STATEMENT NUM-IF SO ENTER IN SYMBOL TABLE
   15 IF(JSYM(2).NE.0) CALL ENTER
C
C     NOW DECODE STATEMENT BY CLASS
C ... IF NO KEY WORD PRESENT-ASSUMED ARITHMETIC
C
  20  IF(BCHR.EQ. 0)GOTO 96
      BCHR=NXTCHR(IOUTX)
      IF(ITSTCH(BCHR).NE.1)GOTO 20
C
C     INPUT BUFFER POINTING AT FIRST ALPHA-GET STATEMENT
C     .CLASS
C
22    ICLASS=ISTMT(BUFR,IOUTX)
	IF(ICLASS.NE.1) GOTO 23
	IOUTX=IOUTX-1		!BACK OVER FIRST ALPHA
23	IF(BUFR(IOUTX).EQ."50 )IPARNS=IPARNS+1
	BCHR=NXNCHR(IOUTX)	!GET NEXT NON-SPACE CHAR
C
C     DISPATCH AND PROCESS STATEMENTS ACCORDING TO
C     THEIR CLASS
C
      GO TO (25,30,90,90,48,35,70,40,90,55,90,90,
     143,90,90,90,50,52,90,90,55,60,98,97),ICLASS
C
C     ALL STATEMENTS WHICH FAIL TO MATCH ON KEY WORD ARE
C     TREATED AS ARITHMETIC---CK FOR EQUAL SIGN
C
   25 DO 26 I=IOUTX,INCNT
      IF (BUFR(I).EQ."75) GO TO 27
   26 CONTINUE
      CALL ERROR (1)  !UN-RECOGNIZED STATEMENT
      ICLASS=31
   27 NSYMTP=NXTSYM(BCHR)
      IF(NSYMTP.LE.0) GO TO 96
      CALL ENTER
      ICLASS=31
      GO TO 90
C
C *** ASSIGN STATEMENT
C
   30 NSYMTP=NXTSYM(BCHR)
      IF(NSYMTP.GE.0) GO TO 96
      CALL ENTER
   32 BCHR=NXTCHR(IOUTX)
      IF(BCHR.EQ.0) GO TO 96
      IF(BCHR.NE."117) GO TO 32
      BCHR=NXTCHR(IOUTX)
      NSYMTP=NXTSYM(BCHR)
      IF(NSYMTP.LE.0) GO TO 96
      CALL ENTER
      GO TO 97		!EMPTY CURRENT BUFFER
C
C *** CALL STATEMENT--- CLASS 6 =CALL ARGUMENT
C			...CLASS 15 = EXTERNAL PROCEDURE
C
   35 NSYMTP=NXTSYM(BCHR)
      IF(NSYMTP.LE.0) GO TO 96
      ICLASS=15		!CLASS 15 IS EXTERNAL PROCESS
      CALL ENTER  	!ENTER PROCEDURE NAME
      ICLASS=6		!CLASS 6 = CALL ARGUMENT
      GO TO 90
C
C *** COMMON STATEMENT---SET PSECT DEF TO CLASS 29
C
   40 ICLASS=29
      NSYMTP=NXTSYM(BCHR)
	IF(NSYMTP)40,1,41
41    IF(BCHR.NE."57) ICLASS=8
      CALL ENTER
      GO TO 40
C
C     DO STATEMENT
C
43	DO 44 I=IOUTX,INCNT
	IF(BUFR(I).EQ."75) GOTO 45
44	CONTINUE
	GOTO 26
45	DO 46 I=I,INCNT
	IF(BUFR(I).EQ. "54)GOTO 47
46	CONTINUE
	IOUTX=IOUTX-2		!ADJUST BACK OVER DO STATEMENT
	GOTO 25			!ASSUME ARITHMETIC
47	NSYMTP=NXTSYM(BCHR)
      IF(NSYMTP.GE.0) GO TO 96
      CALL ENTER
      NSYMTP=NXTSYM(BCHR)
      IF(NSYMTP.LE.0) GO TO 96
	GOTO 91
C
C     TYPE DEFINITION (BYTE-ETC.)
C
   48 IF(BCHR.EQ.0) GO TO 96
      IF(ITSTCH(BCHR).EQ.1) GO TO 49
      BCHR=NXTCHR(IOUTX)
      GO TO 48
   49 ICLASS=ISTMT(BUFR,IOUTX)
      IF(ICLASS.NE.1) GO TO 23
      ICLASS=5
      GO TO 90
C
C     GO TO - TAKE EVERYTHING
C
50	IGTPR=0
   61 NSYMTP=NXTSYM(BCHR)
      IF(NSYMTP.EQ.0) GO TO 1
	IF(IPARNS.GT.0)IGTPR=1
	IF(IPARNS.LE.0.AND.IGTPR.NE.0.AND.NSYMTP.LT.0)GO TO 61
      CALL ENTER
      GO TO 61
C
C     IF (E) I,J,K--- IF (LOG) STMT
C
52	CONTINUE
      NSYMTP=NXTSYM(BCHR)
	IF(NSYMTP)53,96,51
51    CALL ENTER
53    IF(IPARNS.NE.0) GO TO 52
   54 BCHR=NXNCHR(IOUTX)
      IF(BCHR.EQ.0) GO TO 96
      IF(ITSTCH(BCHR).EQ.2) GOTO 50
	GOTO 22
C
C***PROCESS READ (...,OR WRITE (...,OR ENCODE(...,OR DECODE(...,
C   THIS ROUTINE GETS THE FIRST SYMBOL,IF NUMERIC,THROUGH'S
C   IT AWAY-ITS A CONTANT.
C
55	NSYMTP=NXTSYM(BCHR)
	IF(NSYMTP)59,96,58
58	CALL ENTER
59	IF (BCHR.EQ.39) BCHR=NXTCHR(IOUTX)
	JNTC=I5END
	GO TO 56
C
C***THIS ROUTINE PROCESS REMAINING PART OF READ,WRITE,ETC
C   UNTIL A ZERO PARANS COUNT IS REALIZED.
C   IT PICKS UP ALL SYMBOLS THAT ARE NOT TERMINATED WITH AN '='
C
70	JNTC=0
56	IF(IPARNS.EQ. 0) GOTO 90
57	NSYMTP=NXTSYM(BCHR)
	IF(NSYMTP.EQ.0) GOTO 96
	IF(BCHR.EQ."75)GOTO 71
	IF (NSYMTP.GT.0) GO TO 72
	IF (IPARNS.GT.1) GO TO 56
	IF (JNTC.NE.I5ERR.AND.JNTC.NE.I5END) GO TO 56
72	CALL ENTER
	GOTO 56
71	JNTC=JSYM(1)
	GO TO 56
C
C***PROCESS ACCEPT,TYPE,READ
C
60	NSYMTP=NXTSYM(BCHR)	!GET FORMAT NUMBER
	IF(NSYMTP.EQ.0) GOTO 96	!SHOULD HAVE FORMAT SPEC
	GOTO 91			!ENTER FORMAT NUMBER---AND SCAN REST
C
C***PROCESS DATA STATMENT
C	IGNORE EVERY THING BETWEEN '/'S
C
C
C***GENERAL SYMBOL PROCESSOR
C   THIS ROUTINE SCANS THE CURRENT STATEMENT FOR SYMBOLS
C   IT IGNORS ANY NUMERIC SYMOLS ASSUMING THEM TO BE CONSTANTS
C
90    NSYMTP = NXTSYM(IOUTX)
	IF (NSYMTP)90,1,91
91    CALL ENTER
      GO TO 90
C *** STATEMENT SYNTAX ERROR***
C
   96 CALL ERROR(2)
   97 IF (BCHR.EQ.0) GO TO 1
      IOUTX=INCNT		!MAKE BUFFER LOOK EMPTY
      BCHR=NXTCHR(IOUTX)  	!IGNOR REST OF STATEMENT
      GO TO 97
C
C     END STATEMENT-END OF CURRENT INPUT SEQUENCE
C
98	IF(BCHR.EQ.0) GOTO 99
	BCHR=NXNCHR(IOUTX)
	GOTO 98
   99 RETURN
      END