C     ALGORITHM 605 COLLECTED ALGORITHMS FROM ACM.
C     ALGORITHM APPEARED IN ACM-TRANS. MATH. SOFTWARE, VOL.9, NO. 4,
C     DEC., 1983, P. 391-394.
C***********************************************************************
C
C  PROGRAM         PBASIC  VERSION 2.2   SEPTEMBER 1981
C  -------
C
C  AUTHOR          T.R.HOPKINS
C  ------
C
C  ADDRESS         THE COMPUTING LABORATORY,
C  -------         THE UNIVERSITY OF KENT AT CANTERBURY,
C                  CANTERBURY, CT2 7NF,
C                  KENT, ENGLAND.
C
C  LANGUAGE        PFORT - A PORTABLE SUBSET OF ANSI FORTRAN (1966)
C  --------
C
C  PURPOSE         THIS PROGRAM TAKES AS ITS DATA A BASIC PROGRAM
C  -------         AND CHECKS IT FOR CONFORMANCE TO THE ANSI
C                  MINIMAL BASIC STANDARD (ANSI X3.60-1978).
C
C                  THE PROGRAM CHECKS THAT
C                  1) EACH LINE ADHERES STRICTLY TO THE DEFINED SYNTAX
C                  2) THE BASIC PROGRAM CONTAINS NONE OF THE CONTEXT
C                     SENSITIVE OR CONTEXT FREE ERRORS LISTED IN VOL. 1
C                     OF THE NBS MINIMAL BASIC TEST PROGRAMS - VERSION
C                     2, USERS MANUAL.
C
C                  THE OUTPUT PRODUCED CONSISTS OF
C                  1) A LISTING OF THE BASIC PROGRAM AS PRESENTED PLUS
C                     ANY WARNINGS OR ERRORS MESSAGES
C                  2) CROSS REFERENCE TABLES
C                     A) BY VARIABLE / FUNCTION NAME
C                     B) BY STATEMENT TYPE
C                     C) BY LINE NUMBERS USED AS TRANSFERS.
C
C  RUNNING THE PROGRAM
C  -------------------
C                  THE PROGRAM EXPECTS THE BASIC PROGRAM TO BE CHECKED
C                  TO BE ON CHANNEL NIN (DEFAULT = 5)
C                  THE DATA MUST BE TERMINATED BY A RECORD CONTAINING
C                  A FULL STOP IN CHARACTER POSITION 1.  THIS
C                  RESTRICTION MAY BE REMOVED BY CHANGING THE ROUTINE
C                  INSTAT IN A NON-STANDARD WAY.
C
C                  THE BASIC PROGRAM LISTING + ERROR MESSAGES ARE OUTPUT
C                  ON CHANNEL NOUT (DEFAULT = 6)
C
C                  THE CROSS REFERENCE TABLES ARE OUTPUT ON CHANNEL NTAB
C                  (DEFAULT = 8)
C
C  EFFICIENCY      THE SPEED OF EXECUTION MAY BE IMPROVED CONSIDERABLY
C  ----------      BY PROVIDING A MACHINE DEPENDENT VERSION OF THE
C                  INTEGER FUNCTION CODECH.  THIS IS USED TO MAP THE
C                  CHARACTERS OF THE BASIC PROGRAM INTO AN INTERNAL
C                  CODE.  TO EENSURE PORTABILITY THE PROVIDED ROUTINE
C                  IMPLEMENTS A STRAIGHTFORWARD LINEAR SEARCH.
C
C  PORTABILITY     THE PROGRAM HAS BEEN SUCCESSFULLY RUN WITH A
C  -----------     MINIMAL NUMBER OF CHANGES (SEE ACCOMPANYING
C                  DOCUMENTATION) ON
C
C                  (1) ICL 2960 UNDER EMAS - FORTE COMPILER
C                  (2) CDC 7600 UNDER SCOPE 3.2 - FTN4 COMPILER
C
C***********************************************************************
C..LOCAL VARIABLES
      INTEGER CLASS, I, K1
      LOGICAL WRERR
C..FUNCTIONS
      INTEGER CODE
      LOGICAL EATSP
C..COMMON BLOCKS
C****CARFUN
C  ARSTAK -  COL 1 HOLDS CODE OF ARRAY /FUNCTION (-1 IF NON-ANSI)
C             COL 2 HOLDS LEVEL OF PARENTHESIS AT WHICH ARRAY/FUNCTION O
C             COL 3 HOLDS NUMBER OF DIMENSIONS/ARGUMENTS
C   NEXT1 - NEXT AVAILABLE ROW IN ARSTAK
C  LPOPEN - CURRENT DEPTH OF OPEN (LEFT) PARENTHESES
C  DLPREQ - DEPTH OF OPEN (LEFT) PARENTHESES OF CURRENT ARRAY/FUNCTION
C
C  ARPOS  ROW OF ARSTAK AT PRESENT OPEN
C
C
      INTEGER ARPOS, ARSTAK, DLPREQ, LARST, LPOPEN, NEXT1
      COMMON /CARFUN/ LARST, ARSTAK(40,3), NEXT1, LPOPEN,
     * DLPREQ, ARPOS
C
C****CCHAIN
C  LCHAIN - DECLARED LENGTH OF ARRAY CHAINS
C  NCHAIN - POINTER TO NEXT AVAILABLE LINK IN CHAIN
C   CHAIN - ARRAY OF REFERENCES TO VARIABLES AND STATEMENT NUMBERS
C
      INTEGER LCHAIN, NCHAIN, CHAIN
      COMMON /CCHAIN/ LCHAIN, NCHAIN, CHAIN(5000)
C
C****CDO
C     LDO - MAXIMUM NUMBER OF OPEN FOR STATEMENTS ALLOWED
C   DOPEN - NUMBER OF CURRENTLY OPEN FOR STATEMENTS
C  DOSPEC - ARRAY HOLDING CONTROL VARIABLES OF OPEN FOR-LOOPS
C           IN CODE FORM
C
      INTEGER LDO, DOPEN, DOSPEC
      COMMON /CDO/ LDO, DOPEN, DOSPEC(30)
C
C****CERROR
C   NUMST - NUMBER OF STATEMENTS PROCESSED
C  NUMERR - NUMBER OF ERROR MESSAGES PRINTED
C  ENDERR - BOOLEAN SET TRUE IF BASIC END STATEMENT FOUND ELSE FALSE
C  LABENO - CURRENT STATEMENT NUMBER
C  LABERR - BOOLEAN SET TRUE IF PROGRAM STATEMENT NUMBER ARE NOT IN
C            ORDER, FALSE OTHERWISE
C
      INTEGER NUMST, NUMERR, LABENO
      LOGICAL ENDERR, LABERR
      COMMON /CERROR/ NUMST, NUMERR, ENDERR, LABENO, LABERR
C
C****CEXPR
C   TCODE - SEE COMMENTS IN SUBROUTINE EXPRES
C    TYPE - SEE COMMENTS IN SUBROUTINE EXPRES
C     ERR - TRUE IF SPACES INSIDE TOKEN, FALSE OTHERWISE
C   VCODE - VARIABLE CODE IF LEGAL VARIABLE, ZERO OTHERWISE
C  SIMPST - TRUE IF SIMPLE STRING FOUND  FALSE OTHERWISE
C  ENDEXP - POSITION IN LINE OF END OF EXPRESSION
C
      LOGICAL ERR, SIMPST
      INTEGER TCODE, TYPE, VCODE, ENDEXP
      COMMON /CEXPR/ TCODE, TYPE, ERR, VCODE, ENDEXP, SIMPST
C
C****CFOR1
C    LFOR - DECLARED LENGTH OF ARRAY FORNXT
C    NFOR - POSITION OF LAST ENTRIES IN FORNXT
C  FORNXT - ARRAY HOLDING STATEMENT NUMBERS OF FORS AND MATCHING NEXTS
C   LJUMP - DECLARED LENGTH OF ARRAY JUMPS
C   NJUMP - POSITION OF LAST ENTRIES IN JUMPS
C   JUMPS - ARRAY HOLDING STATEMENT NUMBERS AND DESTINATIONS OF
C           FORWARD TRANSFERS
C  ABNFOR - LOGICAL IF SET TRUE THEN CHECKING OF TRANSFER INTO FOR
C           BLOCKS IS ABANDONED - SET TRUE IF ILLEGAL NESTING OCCURS
C
      LOGICAL ABNFOR
      INTEGER LFOR, NFOR, FORNXT, LJUMP, NJUMP, JUMPS
      COMMON /CFOR1/ LFOR, NFOR, FORNXT(50,2), LJUMP, NJUMP,
     * JUMPS(500,2), ABNFOR
C
C****CIO
C     NIN - INPUT CHANNEL FOR BASIC PROGRAM
C    NOUT - OUTPUT CHANNEL FOR VERIFIED PROGRAM AND ERROR MESSAGES
C    NTAB - OUTPUT CHANNEL FOR CROSS REFERENCE TABLES ETC.
C   ENDIN - BOOLEAN SET TRUE WHEN END OF INPUT FILE FOUND
C
      INTEGER NIN, NOUT, NTAB
      LOGICAL ENDIN
      COMMON /CIO/ NIN, NOUT, NTAB, ENDIN
C
C****CKREF
C  LKEY   - FIRST DIMENSION OF THE ARRAY KEYREF
C  KEYREF - ARRAY HOLDING POINTERS TO ARRAY CHAIN
C  Z      - ARRAY OF STATEMENT NAMES FOR OUTPUT
C
      INTEGER KEYREF, LKEY, Z
      COMMON /CKREF/ LKEY, KEYREF(21,2), Z(114)
C
C****CLINE
C   LLINE - DECLARED LENGTH OF ARRAY LINE SPECIFIES MAXIMUM LENGTH OF
C           EACH BASIC STATEMENT (DEPENDS ON THE BASIC IMPLEMENTATION)
C   NLINE - POSITION OF LAST NON-BLANK CHARACTER OF CURRENT LINE
C  MAXLIN - MAXIMUM LEGAL LENGTH OF A BASIC STATEMENT
C           (72 FOR ANSI)
C    LINE - ARRAY HOLDING CODED BASIC STATEMENT
C
      INTEGER LLINE, NLINE, MAXLIN, LINE
      COMMON /CLINE/ LLINE, NLINE, MAXLIN, LINE(80)
C
C****CNXTCH
C      K3 - POSITION OF NEXT NON-BLANK IN LINE
C   ICODE - CODE OF NEXT NON-BLANK IN LINE
C
C  NOTE: K3 IS SET -1 IF END OF LINE IS ENCOUNTERED
C        THESE VARIABLES ARE SET BY NEXTOK
C
      INTEGER K3, JCODE
      COMMON /CNXTCH/ K3, JCODE
C
C****COPT
C  DIMYET - LOGICAL TRUE IF DIM STATEMENT HAS BEEN ENCOUNTERED
C  OPTYET - LOGICAL TRUE IF OPTION STATEMENT HAS BEEN ENCOUNTERED
C  OPTSET - CONTAINS SETTING OF FIRST OPTION STATEMENT  ZERO OR ONE
C
      LOGICAL DIMYET, OPTYET
      INTEGER OPTSET
      COMMON /COPT/ DIMYET, OPTYET, OPTSET
C
C****CREFER
C    NREF - NUMBER OF REFERENCES SAVED IN ARRAY REF
C     REF - ARRAY USED TO STORE REFERENCES TO BE ADDED
C           TO ARRAY CHAIN
C
      INTEGER NREF, REF
      COMMON /CREFER/ NREF, REF(40)
C
C****CSARG
C  ARRDIM - ARRAY HOLDING SIZE OF ARRAYS DEFINED IN DIM STATEMENT
C           (IF MORE THAN TWO - FIRST TWO ONLY ARE KEPT)
C  ARRSUB - ARRAY HOLDING NUMBER OF SUBSCRIPTS OF EACH ARRAY
C           (POSITIVE IF VIA DIM STATEMENT, NEGATIVE IF BY REFERENCE)
C   ISFUN - ARRAY HOLDING CODED FORM OF STANDARD FUNCTIONS
C    FARG - ARRAY HOLDING NUMBER OF ARGUMENTS OF USER DEFINED FUNCTIONS
C           (-N-1 IF NOT FROM DEF, N IF FROM DEF, INITIALIZED -999)
C
      INTEGER ARRDIM, ARRSUB, ISFUN, FARG
      COMMON /CSARG/ ARRDIM(26,2), ARRSUB(26), ISFUN(11,3),
     * FARG(26)
C
C****CSTAT
C   LSTAT - DECLARED LENGTH OF ARRAYS STATNO AND STAREF
C   NSTAT - POSITION OF LAST ENTRIES IN STATNO AND STAREF
C  BNSTAT - NUMBER OF FORWARD REFERENCES
C  STATNO - ARRAY HOLDING STATEMENT NUMBERS
C  STAREF - ARRAY HOLDING POINTERS TO REFERENCE IN CHAIN
C
      INTEGER LSTAT, NSTAT, BNSTAT, STATNO, STAREF
      COMMON /CSTAT/ LSTAT, NSTAT, BNSTAT, STATNO(500),
     * STAREF(500,2)
C
C****CTOKEN
C    LTOK - DECLARED LENGTH OF ARRAY TOKEN
C    NTOK - LENGTH OF CURRENT TOKEN
C   TOKEN - ARRAY HOLDING CURRENT TOKEN
C
      INTEGER NTOK, LTOK, TOKEN
      COMMON /CTOKEN/ LTOK, NTOK, TOKEN(72)
C
C****CTREE
C    KALP - ARRAY HOLDING CODED BASIC KEYWORDS IN TREE FORM
C    KSUC - ARRAY HOLDING SUCCESSFUL MATCH LINKS
C    KFAL - ARRAY HOLDING FAILURE LINKS
C
      INTEGER KALP, KFAL, KSUC
      COMMON /CTREE/ KALP(72), KSUC(72), KFAL(72)
C
C****CVAR
C    LVAR - TOTAL NUMBER OF VARIABLE REFERENCES, DECLARED LENGTH
C           OF IVAR
C    IVAR - ARRAY FOR POINTERS TO REFERENCE IN ARRAY CHAIN EACH
C           VARIABLE IS ACCESSED BY CODE NUMBER
C
      INTEGER LVAR, IVAR
      COMMON /CVAR/ LVAR, IVAR(376,2)
C
C  INITIALIZATION OF COMMON BLOCK VARIABLES
C
C
C**BLOCK CARFUN
C
      LARST = 40
      DLPREQ = -1
      ARPOS = 0
C
C**BLOCK CCHAIN
C
      LCHAIN = 5000
      NCHAIN = 1
C
C**BLOCK CDO
C
      LDO = 30
      DOPEN = 0
C
C**BLOCK CERROR
C
      NUMST = 0
      NUMERR = 0
      ENDERR = .FALSE.
      LABENO = 0
      LABERR = .FALSE.
C
C**BLOCK CFOR1
C
      LFOR = 50
      NFOR = 0
C  INITIALIZE SECOND COLUMN OF FORNXT TO ZERO SO CAN TELL
C  WHETHER NEXT STATEMENT HAS BEEN FOUND
      DO 10 I=1,LFOR
        FORNXT(I,2) = 0
   10 CONTINUE
      LJUMP = 500
      NJUMP = 0
      ABNFOR = .FALSE.
C
C**BLOCK CIO
C
      NIN = 5
      NOUT = 6
      NTAB = 8
C
C  REWIND ALL I/O FILES
C
      REWIND NIN
      REWIND NOUT
      REWIND NTAB
      ENDIN = .FALSE.
C
C**BLOCK CKREF
C
      LKEY = 21
C  MARK FIRST COLUMN OF KEYREF
      DO 20 I=1,LKEY
        KEYREF(I,1) = 0
   20 CONTINUE
C
C**BLOCK CLINE
C
      LLINE = 80
      MAXLIN = 72
C
C**BLOCK COPT
C
      DIMYET = .FALSE.
      OPTYET = .FALSE.
      OPTSET = -1
C
C**BLOCK CSARG
C
C  INITIALIZE NUMBER OF ARRAY SUBSCRIPTS TO ZERO
C  MARK FIRST COLUMN OF ARRAY DIMENSIONS
C  MARK FARG ARRAY
      DO 30 I=1,26
        ARRSUB(I) = 0
        ARRDIM(I,1) = -1
        FARG(I) = -999
   30 CONTINUE
C
C**BLOCK CSTAT
C
      LSTAT = 500
      NSTAT = 0
      BNSTAT = -1
C  ZERO FIRST COLUMN OF STAREF
      DO 40 I=1,LSTAT
        STAREF(I,1) = 0
   40 CONTINUE
C
C**BLOCK CTOKEN
C
      LTOK = 72
C
C**BLOCK CVAR
C
      LVAR = 376
C  ZERO FIRST COLUMN OF IVAR
      DO 50 I=1,LVAR
        IVAR(I,1) = 0
   50 CONTINUE
C
C**LOCALS
C
      WRERR = .FALSE.
C  READ IN A STATEMENT
   60 CALL INSTAT
C  TEST FOR END OF INPUT - OUTPUT X-REF TABLES ETC.
      IF (ENDIN) GO TO 290
C  CHECK THAT THE STATEMENT NUMBER CONFORMS TO THE STANDARD
      CALL CHKLAB
C  CHECK STATEMENT NUMBERS ARE IN ASCENDING ORDER
      IF (.NOT.LABERR) GO TO 70
      CALL ERROR(19H****FATAL ERROR****, 19)
      CALL
     * ERROR(
     * 52HSTATEMENT NUMBERS NOT ORDERED - PROCESSING ABANDONED,
     * 52)
      GO TO 300
C TEST IF LABENO=-1 I.E. MISSING STATEMENT NUMBER
   70 IF (-1.NE.LABENO) GO TO 80
      CALL ERROR(42HSTATEMENT NUMBER MISSING STATEMENT IGNORED,
     * 42)
      GO TO 60
C TEST IF STATEMENT NUMBER ZERO
   80 IF (0.NE.LABENO) GO TO 90
      CALL ERROR(39HSTATEMENT NUMBER ZERO STATEMENT IGNORED, 39)
      GO TO 60
C  TEST IF THERE IS ONLY A STATEMENT NUMBER ON THE LINE
   90 IF (-1.NE.K3) GO TO 100
      CALL ERROR(28HSTATEMENT LABEL ONLY ON LINE, 28)
C  GET NEXT KEY WORD
      GO TO 60
C  CLASSIFY KEY WORD
  100 CALL CLASFY(CLASS, ERR)
      CALL ADDREF(KEYREF, LKEY, LABENO, CLASS)
      IF (CLASS.LT.21) GO TO 110
      CALL
     * ERROR(46HNON-STANDARD KEYWORD REST OF STATEMENT IGNORED,
     * 46)
      GO TO 60
C  CHECK NO SPACES IN KEYWORD
  110 IF (ERR) CALL ERROR(17HSPACES IN KEYWORD, 17)
      IF (.NOT.ENDERR .OR. WRERR) GO TO 120
      WRERR = .TRUE.
      CALL ERROR(31HSTATEMENT FOLLOWS END STATEMENT, 31)
C  UNLESS KEYWORD CAN OCCUR ALONE ON THE LINE (END,STOP,RESTORE,
C  RANDOMIZE,PRINT,REM) CHECK AT LEAST ONE SPACE FOLLOWS.
  120 IF (CLASS.EQ.4 .OR. CLASS.EQ.14 .OR. CLASS.EQ.15 .OR.
     * (CLASS.GE.17 .AND. CLASS.LE.20)) GO TO 140
      K1 = K3 + 1
      ERR = EATSP(K1,K3)
      IF (-1.NE.K3) GO TO 130
C  AT END OF LINE OF OUTPUT ERROR AND GET NEXT LINE
      CALL ERROR(27HKEYWORD CANNOT APPEAR ALONE, 27)
      GO TO 60
  130 IF (.NOT.ERR) CALL ERROR(24HNO SPACE FOLLOWS KEYWORD, 24)
      JCODE = CODE(K3)
C
C  CHECK EACH PARTICULAR STATEMENT ADHERES TO ANSI-STANDARD
C
C  1. DATA      2. DEF       3. DIM        4. END
C  5. FOR       6. GOSUB     7. GOTO       8. IF
C  9. INPUT    10. LET      11. NEXT      12. ON
C 13. OPTION   14. PRINT    15. RANDOMIZE 16. READ
C 17. REM      18. RESTORE  19. RETURN    20. STOP
C
C            21. NON-ANSI KEYWORD
C
  140 GO TO (150, 160, 170, 180, 190, 200, 200, 210, 220, 230,
     * 240, 250, 260, 270, 180, 220, 280, 180, 180, 180), CLASS
C  DATA STATEMENT
  150 CALL DATA
      GO TO 60
C  DEF STATEMENT
  160 CALL DEF
      GO TO 60
C  DIM STATEMENT
  170 CALL DIM
      GO TO 60
C  END,RANDOMIZE,RESTORE,RETURN, OR STOP STATEMENT
  180 CALL RSTEND(CLASS)
      GO TO 60
C  FOR STATEMENT
  190 CALL FORST
      GO TO 60
C  GOTO OR GOSUB STATEMENT
  200 CALL GOTOS
      GO TO 60
C  IF STATEMENT
  210 CALL IFST
      GO TO 60
C  INPUT OR READ STATEMENT
  220 CALL INREAD
      GO TO 60
C  LET STATEMENT
  230 CALL LETST
      GO TO 60
C  NEXT STATEMENT
  240 CALL NEXT
      GO TO 60
C  ON STATEMENT
  250 CALL ONSTAT
      GO TO 60
C  OPTION BASE STATEMENT
  260 CALL OPTSMT
      GO TO 60
C  PRINT STATEMENT
  270 CALL PRINT
      GO TO 60
C  REM STATEMENT
  280 CALL REM
      GO TO 60
C  END OF FILE FOUND - TIDY UP, OUTPUT X-REF TABLES
C  FOR VARIABLES AND STATEMENT NUMBERS
  290 CALL TIDYUP
      CALL XRSTNO
      CALL XRVARS
      CALL XRSTAT
  300 STOP
      END
C***
C                    BLOCK DATA ROUTINES
C***
      BLOCK DATA
C
C  INITIALIZE STATEMENT NAMES IN ARRAY Z
C  THIS IS USED FOR OUTPUT OF TABLES
C
C..COMMON BLOCKS
      INTEGER KEYREF, LKEY, Z
      COMMON /CKREF/ LKEY, KEYREF(21,2), Z(114)
      DATA LKEY /21/
      DATA Z(1) /4/
      DATA Z(2) /1HD/
      DATA Z(3) /1HA/
      DATA Z(4) /1HT/
      DATA Z(5) /1HA/
      DATA Z(6) /3/
      DATA Z(7) /1HD/
      DATA Z(8) /1HE/
      DATA Z(9) /1HF/
      DATA Z(10) /3/
      DATA Z(11) /1HD/
      DATA Z(12) /1HI/
      DATA Z(13) /1HM/
      DATA Z(14) /3/
      DATA Z(15) /1HE/
      DATA Z(16) /1HN/
      DATA Z(17) /1HD/
      DATA Z(18) /3/
      DATA Z(19) /1HF/
      DATA Z(20) /1HO/
      DATA Z(21) /1HR/
      DATA Z(22) /5/
      DATA Z(23) /1HG/
      DATA Z(24) /1HO/
      DATA Z(25) /1HS/
      DATA Z(26) /1HU/
      DATA Z(27) /1HB/
      DATA Z(28) /4/
      DATA Z(29) /1HG/
      DATA Z(30) /1HO/
      DATA Z(31) /1HT/
      DATA Z(32) /1HO/
      DATA Z(33) /2/
      DATA Z(34) /1HI/
      DATA Z(35) /1HF/
      DATA Z(36) /5/
      DATA Z(37) /1HI/
      DATA Z(38) /1HN/
      DATA Z(39) /1HP/
      DATA Z(40) /1HU/
      DATA Z(41) /1HT/
      DATA Z(42) /3/
      DATA Z(43) /1HL/
      DATA Z(44) /1HE/
      DATA Z(45) /1HT/
      DATA Z(46) /4/
      DATA Z(47) /1HN/
      DATA Z(48) /1HE/
      DATA Z(49) /1HX/
      DATA Z(50) /1HT/
      DATA Z(51) /2/
      DATA Z(52) /1HO/
      DATA Z(53) /1HN/
      DATA Z(54) /6/
      DATA Z(55) /1HO/
      DATA Z(56) /1HP/
      DATA Z(57) /1HT/
      DATA Z(58) /1HI/
      DATA Z(59) /1HO/
      DATA Z(60) /1HN/
      DATA Z(61) /5/
      DATA Z(62) /1HP/
      DATA Z(63) /1HR/
      DATA Z(64) /1HI/
      DATA Z(65) /1HN/
      DATA Z(66) /1HT/
      DATA Z(67) /9/
      DATA Z(68) /1HR/
      DATA Z(69) /1HA/
      DATA Z(70) /1HN/
      DATA Z(71) /1HD/
      DATA Z(72) /1HO/
      DATA Z(73) /1HM/
      DATA Z(74) /1HI/
      DATA Z(75) /1HZ/
      DATA Z(76) /1HE/
      DATA Z(77) /4/
      DATA Z(78) /1HR/
      DATA Z(79) /1HE/
      DATA Z(80) /1HA/
      DATA Z(81) /1HD/
      DATA Z(82) /3/
      DATA Z(83) /1HR/
      DATA Z(84) /1HE/
      DATA Z(85) /1HM/
      DATA Z(86) /7/
      DATA Z(87) /1HR/
      DATA Z(88) /1HE/
      DATA Z(89) /1HS/
      DATA Z(90) /1HT/
      DATA Z(91) /1HO/
      DATA Z(92) /1HR/
      DATA Z(93) /1HE/
      DATA Z(94) /6/
      DATA Z(95) /1HR/
      DATA Z(96) /1HE/
      DATA Z(97) /1HT/
      DATA Z(98) /1HU/
      DATA Z(99) /1HR/
      DATA Z(100) /1HN/
      DATA Z(101) /4/
      DATA Z(102) /1HS/
      DATA Z(103) /1HT/
      DATA Z(104) /1HO/
      DATA Z(105) /1HP/
      DATA Z(106) /8/
      DATA Z(107) /1HN/
      DATA Z(108) /1HO/
      DATA Z(109) /1HN/
      DATA Z(110) /1H-/
      DATA Z(111) /1HA/
      DATA Z(112) /1HN/
      DATA Z(113) /1HS/
      DATA Z(114) /1HI/
      END
      BLOCK DATA
C
C  INITIALIZE TREE FOR IDENTIFICATION OF BASIC STATEMENTS
C
C..COMMON BLOCKS
      INTEGER KALP, KFAL, KSUC
      COMMON /CTREE/ KALP(72), KSUC(72), KFAL(72)
      DATA KALP(1), KALP(2), KALP(3), KALP(4), KALP(5),
     * KALP(6), KALP(7), KALP(8), KALP(9), KALP(10), KALP(11),
     * KALP(12), KALP(13), KALP(14), KALP(15), KALP(16),
     * KALP(17), KALP(18), KALP(19), KALP(20), KALP(21),
     * KALP(22), KALP(23), KALP(24), KALP(25), KALP(26),
     * KALP(27), KALP(28), KALP(29), KALP(30), KALP(31),
     * KALP(32), KALP(33), KALP(34), KALP(35), KALP(36),
     * KALP(37), KALP(38), KALP(39), KALP(40), KALP(41),
     * KALP(42), KALP(43), KALP(44), KALP(45), KALP(46),
     * KALP(47), KALP(48), KALP(49), KALP(50), KALP(51),
     * KALP(52), KALP(53), KALP(54), KALP(55), KALP(56),
     * KALP(57), KALP(58), KALP(59), KALP(60), KALP(61),
     * KALP(62), KALP(63), KALP(64) /21,14,29,18,15,23,25,30,29,
     * 15,24,27,16,24,27,14,22,10,13,29,30,27,23,28,29,24,27,14,
     * 10,23,13,24,22,18,35,14,25,27,18,23,29,23,14,33,29,13,10,
     * 29,10,14,15,18,22,14,23,13,28,29,24,25,24,23,25,29/
      DATA KALP(65), KALP(66), KALP(67), KALP(68), KALP(69),
     * KALP(70), KALP(71), KALP(72) /18,24,23,28,30,11,29,24/
      DATA KSUC(1), KSUC(2), KSUC(3), KSUC(4), KSUC(5),
     * KSUC(6), KSUC(7), KSUC(8), KSUC(9), KSUC(10), KSUC(11),
     * KSUC(12), KSUC(13), KSUC(14), KSUC(15), KSUC(16),
     * KSUC(17), KSUC(18), KSUC(19), KSUC(20), KSUC(21),
     * KSUC(22), KSUC(23), KSUC(24), KSUC(25), KSUC(26),
     * KSUC(27), KSUC(28), KSUC(29), KSUC(30), KSUC(31),
     * KSUC(32), KSUC(33), KSUC(34), KSUC(35), KSUC(36),
     * KSUC(37), KSUC(38), KSUC(39), KSUC(40), KSUC(41),
     * KSUC(42), KSUC(43), KSUC(44), KSUC(45), KSUC(46),
     * KSUC(47), KSUC(48), KSUC(49), KSUC(50), KSUC(51),
     * KSUC(52), KSUC(53), KSUC(54), KSUC(55), KSUC(56),
     * KSUC(57), KSUC(58), KSUC(59), KSUC(60), KSUC(61),
     * KSUC(62) /2,3,-10,5,-8,7,8,9,-9,11,12,-5,14,-21,16,17,
     * -17,19,-16,21,22,23,-19,25,26,27,28,-18,30,31,32,33,34,
     * 35,36,-15,38,39,40,41,-14,43,44,45,-11,47,48,49,-1,51,-2,
     * 53,-3,55,56,-4,58,59,60,-20,62,-12/
      DATA KSUC(63), KSUC(64), KSUC(65), KSUC(66), KSUC(67),
     * KSUC(68), KSUC(69), KSUC(70), KSUC(71), KSUC(72)
     * /64,65,66,67,-13,69,70,-6,72,-7/
      DATA KFAL(1), KFAL(2), KFAL(3), KFAL(4), KFAL(5),
     * KFAL(6), KFAL(7), KFAL(8), KFAL(9), KFAL(10), KFAL(11),
     * KFAL(12), KFAL(13), KFAL(14), KFAL(15), KFAL(16),
     * KFAL(17), KFAL(18), KFAL(19), KFAL(20), KFAL(21),
     * KFAL(22), KFAL(23), KFAL(24), KFAL(25), KFAL(26),
     * KFAL(27), KFAL(28), KFAL(29), KFAL(30), KFAL(31),
     * KFAL(32), KFAL(33), KFAL(34), KFAL(35), KFAL(36),
     * KFAL(37), KFAL(38), KFAL(39), KFAL(40), KFAL(41),
     * KFAL(42), KFAL(43), KFAL(44), KFAL(45), KFAL(46),
     * KFAL(47), KFAL(48), KFAL(49), KFAL(50), KFAL(51),
     * KFAL(52), KFAL(53), KFAL(54), KFAL(55), KFAL(56),
     * KFAL(57), KFAL(58), KFAL(59), KFAL(60), KFAL(61),
     * KFAL(62), KFAL(63), KFAL(64), KFAL(65), KFAL(66),
     * KFAL(67), KFAL(68), KFAL(69), KFAL(70), KFAL(71),
     * KFAL(72) /4,-21,-21,10,6,4*-21,13,2*-21,15,-21,37,29,18,
     * 20,-21,24,16*-21,42,4*-21,46,3*-21,54,50,2*-21,52,3*-21,
     * 57,2*-21,61,4*-21,63,5*-21,71,4*-21/
      END
      BLOCK DATA
C
C  INITIALIZE IMPLEMENTATION SUPPLIED FUNCTIONS IN ARRAY ISFUN(11,3)
C
C..COMMON BLOCKS
      INTEGER ARRDIM, ARRSUB, FARG, ISFUN
      COMMON /CSARG/ ARRDIM(26,2), ARRSUB(26), ISFUN(11,3),
     * FARG(26)
C  ORDER ABS,ATN,COS,EXP,INT,LOG,RND,SGN,SIN,SQR,TAN
      DATA ISFUN(1,1), ISFUN(1,2), ISFUN(1,3) /10,11,28/
      DATA ISFUN(2,1), ISFUN(2,2), ISFUN(2,3) /10,29,23/
      DATA ISFUN(3,1), ISFUN(3,2), ISFUN(3,3) /12,24,28/
      DATA ISFUN(4,1), ISFUN(4,2), ISFUN(4,3) /14,33,25/
      DATA ISFUN(5,1), ISFUN(5,2), ISFUN(5,3) /18,23,29/
      DATA ISFUN(6,1), ISFUN(6,2), ISFUN(6,3) /21,24,16/
      DATA ISFUN(7,1), ISFUN(7,2), ISFUN(7,3) /27,23,13/
      DATA ISFUN(8,1), ISFUN(8,2), ISFUN(8,3) /28,16,23/
      DATA ISFUN(9,1), ISFUN(9,2), ISFUN(9,3) /28,18,23/
      DATA ISFUN(10,1), ISFUN(10,2), ISFUN(10,3) /28,26,27/
      DATA ISFUN(11,1), ISFUN(11,2), ISFUN(11,3) /29,10,23/
      END
C***
C                    SUBROUTINE ADDREF
C***
      SUBROUTINE ADDREF(ARRAY, LARRAY, REF, IPOS)
C
C  ROUTINE TO ADD REFERENCE OF EITHER VARIABLE (ARRAY=IVAR)
C  OR STATEMENT (ARRAY=STATREF) TO THE ARRAY CHAIN.
C
C  LARRAY IS THE LENGTH OF THE ARRAY (LVAR OR LSTAT)
C  REF IS THE INTEGER FORM OF THE STATEMENT NUMBER
C  IPOS IS THE POSITION OF THE VARIABLE/STATEMENT IN THE
C  ARRAY IVAR OR STATREF.
C
C..NOTE - THE ACTUAL ARGUMENT USED IN CALLS TO THIS ROUTINE MAY
C         BE CONTAINED WITHIN COMMON BLOCKS IN THE CALLING SUB-
C         PROGRAM - THIS IS FLAGGED AS AN UNSAFE REFERENCE  BY
C         PFORT BUT IS ACTUALLY SAFE SINCE NONE OF THE ARGUMENTS
C         ARE CHANGED.
C
C..ARGUMENTS
      INTEGER IPOS, LARRAY, REF
      INTEGER ARRAY(LARRAY,2)
C..LOCAL VARIABLES
      INTEGER I
C..COMMON BLOCKS
      INTEGER LCHAIN, NCHAIN, CHAIN
      COMMON /CCHAIN/ LCHAIN, NCHAIN, CHAIN(5000)
C  TEST IF ENOUGH ROOM IN CHAIN TO ADD IN REFERENCE
      IF (NCHAIN.GT.LCHAIN) CALL SYSERR(2)
C  TEST IF THIS IS THE FIRST REFERENCE
      IF (ARRAY(IPOS,1).NE.0) GO TO 10
C  ENTER FIRST LINK
      ARRAY(IPOS,1) = NCHAIN
      GO TO 20
C  OTHERWISE UPDATE LINK IN CHAIN
   10 I = ARRAY(IPOS,2) + 1
      CHAIN(I) = NCHAIN
C  UPDATE LAST REFERENCE AND ADD NEW REFERENCE INTO CHAIN
   20 ARRAY(IPOS,2) = NCHAIN
      CHAIN(NCHAIN) = REF
      NCHAIN = NCHAIN + 2
      RETURN
      END
C***
C                    SUBROUTINE ADDSTA
C***
      SUBROUTINE ADDSTA(REF)
C
C  ADDS STATEMENT REFERENCE TO CHAIN - LABENO IS CURRENT STATEMENT NO.
C  REF IS THE REFERENCED STATEMENT NUMBER
C  STATNO ELEMENTS ARE NEGATIVE IF STATEMENT IS A REM
C
C..ARGUMENTS
      INTEGER REF
C..LOCAL VARIABLES
      INTEGER I, IPOS, IREF, JPOS
C..FUNCTIONS
      LOGICAL BINCHP
C..COMMON BLOCKS
      INTEGER NUMST, NUMERR, LABENO
      LOGICAL ENDERR, LABERR
      INTEGER LSTAT, NSTAT, BNSTAT, STATNO, STAREF
      COMMON /CERROR/ NUMST, NUMERR, ENDERR, LABENO, LABERR
      COMMON /CSTAT/ LSTAT, NSTAT, BNSTAT, STATNO(500),
     * STAREF(500,2)
C  TEST IF FORWARD REFERENCE FOUND
      IF (REF.GT.IABS(STATNO(NSTAT))) GO TO 10
C  REFERENCE SHOULD ALREADY EXIST - BINARY CHOP
      IF (BINCHP(STATNO,1,NSTAT,REF,IPOS)) GO TO 60
      CALL
     * ERROR(44HBACK REFERENCE TO UNDEFINED STATEMENT NUMBER,
     * 44)
      GO TO 70
C  FORWARD REFERENCE FOUND
   10 IF (-1.NE.BNSTAT) GO TO 20
C  NO FORWARD REFERENCES ALREADY EXISTING
      IF (NSTAT.EQ.LSTAT) CALL SYSERR(1)
      BNSTAT = 0
      IPOS = LSTAT
      GO TO 50
C  CHECK FORWARD REFERENCE DOES NOT ALREADY EXIST
   20 IF (BINCHP(STATNO,LSTAT-BNSTAT,LSTAT,REF,IPOS)) GO TO 60
C  PUT REFERENCE INTO POSITION REORDERING IF NECESSARY
      IF (NSTAT.EQ.LSTAT-BNSTAT-1) CALL SYSERR(1)
      BNSTAT = BNSTAT + 1
      IPOS = LSTAT - BNSTAT
      DO 30 I=1,BNSTAT
        IPOS = IPOS + 1
        IF (REF.LT.IABS(STATNO(IPOS))) GO TO 40
        JPOS = IPOS - 1
C SHIFT UP STATEMENTS AND POINTERS
        STATNO(JPOS) = STATNO(IPOS)
        STAREF(JPOS,1) = STAREF(IPOS,1)
        STAREF(JPOS,2) = STAREF(IPOS,2)
   30 CONTINUE
C  PUT STATEMENT NUMBER IN END POSITION
      IPOS = LSTAT
      GO TO 50
C  OTHERWISE INSERT AHEAD OF LAST POSITION
   40 IPOS = IPOS - 1
   50 STATNO(IPOS) = REF
      STAREF(IPOS,1) = 0
C  ADD CURRENT STATEMENT NUMBER TO REFERENCE CHAIN
   60 IREF = LABENO
      CALL ADDREF(STAREF, LSTAT, IREF, IPOS)
   70 RETURN
      END
C***
C                    SUBROUTINE ARWIND
C***
      SUBROUTINE ARWIND(WINDUP)
C
C  ROUTINE FOR KEEPING TRACK ON NUMBER OF DIMENSIONS/VARIABLES
C  IN ARRAYS/FUNCTIONS
C
C  ON ENTRY
C    WINDUP=.FALSE. MEANS LEFT PARENTHESIS FOUND OPEN UP NEW TOKEN
C    WINDUP=.TRUE. MATCHING RIGHT PAREN FOUND CLOSE DOWN CURRENTLY
C                   OPEN TOKEN AND SEARCH FOR ANY OUTER NESTED ONES
C
C..ARGUMENTS
      LOGICAL WINDUP
C..LOCAL VARIABLES
      INTEGER I, ICODE, J
C..COMMON BLOCKS
      INTEGER ARPOS, ARSTAK, DLPREQ, LARST, LPOPEN, NEXT1
      LOGICAL ERR, SIMPST
      INTEGER TCODE, TYPE, VCODE, ENDEXP
      COMMON /CARFUN/ LARST, ARSTAK(40,3), NEXT1, LPOPEN,
     * DLPREQ, ARPOS
      COMMON /CEXPR/ TCODE, TYPE, ERR, VCODE, ENDEXP, SIMPST
      IF (WINDUP) GO TO 10
      IF (NEXT1.GT.LARST) CALL SYSERR(7)
C  ADD NEW FUNCTION / ARRAY TO ARSTAK
      ICODE = VCODE
      IF (VCODE.EQ.0) ICODE = -1
      ARSTAK(NEXT1,1) = ICODE
      ARSTAK(NEXT1,2) = LPOPEN
      ARSTAK(NEXT1,3) = 1
      ARPOS = NEXT1
      NEXT1 = NEXT1 + 1
      DLPREQ = LPOPEN
      GO TO 50
C  WHEN RELEVANT CLOSING BRACKET FOUND I.E. LPOPEN=DLPREQ-1
C  CLOSE THE ROW AT PRESENT OPEN
C  FIRST CHECK SUBSCRIPTS / ARGUMENTS
   10 IF (NEXT1.EQ.1) GO TO 50
      IF (ARSTAK(ARPOS,1).GT.0) CALL CHKSUB(ARSTAK(ARPOS,1),
     * ARSTAK(ARPOS,3))
      ARSTAK(ARPOS,2) = 0
C  LOOK IF ANY OTHERS OPEN - SEARCH BACKWARDS FROM ARPOS
      IF (ARPOS.EQ.1) GO TO 30
      DO 20 I=2,ARPOS
        J = ARPOS + 1 - I
        IF (ARSTAK(J,2).GT.0) GO TO 40
   20 CONTINUE
C  NOT FOUND SET DLPREQ TO -1 AND RETURN
   30 DLPREQ = -1
      ARPOS = 0
      GO TO 50
C  OTHERWISE SET NEXT OPEN ONE
   40 ARPOS = J
      DLPREQ = ARSTAK(ARPOS,2)
   50 RETURN
      END
C***
C                    LOGICAL FUNCTION BINCHP
C***
      LOGICAL FUNCTION BINCHP(ARRAY, START, FIN, TARGET, IPOS)
C
C  BINARY CHOP SORTED SEGMENT OF ARRAY (START - FIN)
C  LOOKING FOR INTEGER TARGET.
C  IF FOUND SET IPOS TO POSITION AND BINCHP TO TRUE
C  IF NOT   SET IPOS TO ZERO     AND BINCHP TO FALSE
C
C  CHECK FIRST THAT TARGET IS S.T.
C       ARRAY(START) .LT. TARGET  .LT.  ARRAY(FIN)
C
C..ARGUMENTS
      INTEGER FIN, START, TARGET
      INTEGER ARRAY(FIN)
C..LOCAL VARIABLES
      INTEGER IPOS, JPOS, KPOS, LPOS
      IF (IABS(ARRAY(START)).LE.TARGET .AND.
     * TARGET.LE.IABS(ARRAY(FIN))) GO TO 10
C  TARGET IS NOT IN THE SORTED LIST
      BINCHP = .FALSE.
      IPOS = 0
      GO TO 60
   10 BINCHP = .TRUE.
      JPOS = START
      KPOS = 2*FIN - START
      IPOS = 0
   20 LPOS = (JPOS+KPOS)/2
      IF (LPOS.NE.IPOS) GO TO 30
C  TARGET NOT FOUND
      BINCHP = .FALSE.
      IPOS = 0
      GO TO 60
C  LOOK IN NEXT POSITION
   30 IPOS = LPOS
      IF (TARGET-IABS(ARRAY(IPOS))) 40, 60, 50
C  TARGET LT PRESENT POSITION
   40 KPOS = IPOS
      GO TO 20
C  TARGET GT PRESENT POSITION
   50 JPOS = IPOS
      GO TO 20
   60 RETURN
      END
C***
C                    LOGICAL FUNCTION CHKFOR
C***
      LOGICAL FUNCTION CHKFOR(BACK, STAT, DEST)
C
C  CHKFOR = .TRUE. IF TRANSFER IS O.K.  FALSE OTHERWISE
C
C  ROUTINE CHECKS FOR ILLEGAL TRANSFER INTO FOR BLOCK
C
C  IF BACK IS FALSE THEN IT IS CALLED FROM TIDYUP AND
C                   FORNXT ARRAY IS COMPLETE
C  IF BACK IS TRUE THEN A BACKWARD REFERENCE IS BEING
C                  PROCESSED AND OPEN FOR LOOPS NEED TO BE CONSIDERED
C
C..ARGUMENTS
      INTEGER DEST, STAT
      LOGICAL BACK
C..LOCAL VARIABLES
      INTEGER I
C..COMMON BLOCKS
      LOGICAL ABNFOR
      INTEGER LFOR, NFOR, FORNXT, LJUMP, NJUMP, JUMPS
      COMMON /CFOR1/ LFOR, NFOR, FORNXT(50,2), LJUMP, NJUMP,
     * JUMPS(500,2), ABNFOR
      CHKFOR = .TRUE.
      IF (ABNFOR) GO TO 60
C  CHECK THERE ARE FOR LOOPS IN THE PROGRAM AT THIS STAGE
      IF (NFOR.EQ.0) GO TO 60
C  BACKWARD REFERENCE
      IF (.NOT.BACK) GO TO 30
      DO 20 I=1,NFOR
C  CHECK IF DESTINATION IS GREATER THAN FOR LABEL
        IF (DEST.LE.FORNXT(I,1)) GO TO 20
C  TEST IF OPEN FOR
        IF (FORNXT(I,2).NE.0) GO TO 10
C  INSIDE OPEN FOR CHECK STATEMENT LABEL IS ALSO
        IF (STAT.GE.FORNXT(I,1)) GO TO 20
        GO TO 50
C  CHECK IF DESTINATION LESS THAN NEXT LABEL
   10   IF (DEST.GT.FORNXT(I,2)) GO TO 20
C  STAT MUST LIE IN THE SAME RANGE
        IF (STAT.LT.FORNXT(I,1) .OR. STAT.GT.FORNXT(I,2)) GO TO
     *   50
   20 CONTINUE
      RETURN
C  CALL FROM TIDYUP FORNXT ARRAY IS FULL
   30 DO 40 I=1,NFOR
        IF (DEST.LE.FORNXT(I,1) .OR. DEST.GT.FORNXT(I,2)) GO TO
     *   40
C DEST IS IN RANGE STAT MUST BE
        IF (STAT.LT.FORNXT(I,1) .OR. STAT.GT.FORNXT(I,2)) GO TO
     *   50
   40 CONTINUE
      RETURN
C  ERROR EXIT
   50 CHKFOR = .FALSE.
   60 RETURN
      END
C***
C                    LOGICAL FUNCTION CHKKEY
C***
      LOGICAL FUNCTION CHKKEY(ARRAY, LENGTH, K1, K2)
C
C  CHKKEY RETURNS TRUE IF KEYWORD IN ARRAY (1 - LENGTH)
C  IS FOUND IN THE ARRAY LINE AND FALSE OTHERWISE
C
C  ON EXIT
C  K1 IS THE POINT AT WHICH THE KEYWORD STARTS
C  K2 IS THE POINT AT WHICH THE KEYWORD ENDS
C
C  ON ENTRY
C  K1 DENOTES THE POINT AT WHICH THE SEARCH IS TO START
C  LENGTH IS ASSUMED GE 2
C
C..ARGUMENTS
      INTEGER K1, K2, LENGTH
      INTEGER ARRAY(LENGTH)
C..LOCAL VARIABLES
      INTEGER I, K, SPACE
C..COMMON BLOCKS
      INTEGER LLINE, NLINE, MAXLIN, LINE
      COMMON /CLINE/ LLINE, NLINE, MAXLIN, LINE(80)
      DATA SPACE /44/
      CHKKEY = .FALSE.
      I = K1
C  LOOK FOR FIRST CHARACTER MATCH
   10 IF (LINE(I).EQ.ARRAY(1)) GO TO 20
C  NO MATCH GET NEXT CHARACTER
      I = I + 1
      IF (I.GT.NLINE) GO TO 50
      GO TO 10
C  FIRST CHARACTER MATCH
   20 K1 = I
      DO 40 K=2,LENGTH
   30   I = I + 1
C  TEST NOT AT END OF LINE
        IF (I.GT.NLINE) GO TO 50
C  IGNORE SPACES
        IF (LINE(I).EQ.SPACE) GO TO 30
C  CHECK NEXT CHARACTER
C  IF NO MATCH - RECHECK WITH ARRAY(1)
        IF (LINE(I).NE.ARRAY(K)) GO TO 10
   40 CONTINUE
C  IF FALL OUT OF LOOP THEN MATCH FOUND
      K2 = I
      CHKKEY = .TRUE.
   50 RETURN
      END
C***
C                    SUBROUTINE CHKLAB
C***
      SUBROUTINE CHKLAB
C
C  ROUTINE CHECKS THAT A STATEMENT NUMBER EXISTS AND THAT IT
C  CONFORMS TO THE STANDARD, CHECKS NEW STATEMENT NUMBER
C  GREATER THAN PREVIOUS, ADDS NUMBER TO LISTS CHECKING THAT NO
C  FORWARD REFERENCE EXISTS.
C
C..LOCAL VARIABLES
      INTEGER K, MAXSNO, SPACE
      LOGICAL ERR
C..FUNCTIONS
      INTEGER CODE, LTOINT
      LOGICAL EATSP
C..COMMON BLOCKS
      INTEGER NUMST, NUMERR, LABENO
      LOGICAL ENDERR, LABERR
      INTEGER LLINE, NLINE, MAXLIN, LINE
      INTEGER K3, JCODE
      INTEGER LSTAT, NSTAT, BNSTAT, STATNO, STAREF
      COMMON /CERROR/ NUMST, NUMERR, ENDERR, LABENO, LABERR
      COMMON /CLINE/ LLINE, NLINE, MAXLIN, LINE(80)
      COMMON /CNXTCH/ K3, JCODE
      COMMON /CSTAT/ LSTAT, NSTAT, BNSTAT, STATNO(500),
     * STAREF(500,2)
      DATA MAXSNO /9999/
      DATA SPACE /44/
C  EAT ANY LEADING SPACES - ERROR IF ANY SPACES FOUND IN POS1 ONWARDS
      IF (EATSP(1,K3)) CALL
     * ERROR(46HONE OR MORE SPACES PRECEEDING STATEMENT NUMBER,
     * 46)
      IF (CODE(K3).EQ.1) GO TO 10
C  NON-NUMERIC FOUND
      LABENO = -1
      GO TO 60
C  GET INTEGER
   10 CALL INTEG(ERR)
C  CHECK STATEMENT NUMBER DOES NOT CONTAIN SPACES
      IF (ERR) CALL ERROR(32HSTATEMENT NUMBER CONTAINS SPACES,
     * 32)
C  CONVERT STATEMENT NUMBER INTO DECIMAL AND TEST IF GREATER
C  THAN MAXSNO
      IF (LTOINT(K).GT.MAXSNO) CALL
     * ERROR(40HSTATEMENT NUMBER EXCEEDS MAXIMUM ALLOWED, 40)
C  TEST IF STATEMENT LABEL ZERO
      IF (K.NE.0) GO TO 20
      LABENO = 0
      GO TO 60
C  TEST IF STATEMENT NUMBER GREATER THAN PREVIOUS LINE
   20 IF (K.GT.LABENO) GO TO 30
C  STATEMENTS NOT ORDERED - SET LABERR = TRUE AND RETURN
      LABERR = .TRUE.
      GO TO 60
   30 LABENO = K
C  CHECK STATEMENT HAS NOT OCCURED AS A FORWARD REFERENCE
   40 IF (BNSTAT.LT.0) GO TO 50
      K = LSTAT - BNSTAT
      IF (LABENO.LT.IABS(STATNO(K))) GO TO 50
      BNSTAT = BNSTAT - 1
      NSTAT = NSTAT + 1
      STATNO(NSTAT) = STATNO(K)
      STAREF(NSTAT,1) = STAREF(K,1)
      STAREF(NSTAT,2) = STAREF(K,2)
C  REINITIALIZE FORWARD REFERENCE POSITION
      STAREF(K,1) = 0
      IF (LABENO.EQ.IABS(STATNO(K))) GO TO 60
C  IF LABENO .GT. STATNO(K) FORWARD REFERENCE IS OUT OF ORDER
C  OR DOES NOT EXIST
C  SET STAREF(NSTAT,1) NEGATIVE
      STAREF(NSTAT,1) = -STAREF(NSTAT,1)
      GO TO 40
C  ENTER CURRENT STATEMENT NUMBER INTO LIST
   50 NSTAT = NSTAT + 1
C  CHECK ENOUGH ROOM FOR NEW STATEMENT NUMBER
      IF (NSTAT+BNSTAT+1.GT.LSTAT) CALL SYSERR(4)
      STATNO(NSTAT) = LABENO
      IF (-1.EQ.K3) GO TO 60
C  CHECK AT LEAST ONE SPACE AFTER STATEMENT NUMBER
      IF (LINE(K3-1).NE.SPACE) CALL
     * ERROR(35HNO SPACE FOLLOWING STATEMENT NUMBER, 35)
   60 RETURN
      END
C***
C                    SUBROUTINE CHKREF
C***
      SUBROUTINE CHKREF(STAT, DEST)
C  IF STAT=DEST TRANSFER IS TO THE SAME STATEMENT
C
C  CHECKS A STATEMENT REFERENCE
C
C  1. IF DESTINATION = CURRENT STATEMENT THEN ERROR
C  2. IF DESTINATION .LT. CURRENT STATEMENT THEN
C        CHECK NOT AN ILLEGAL TRANSFER INTO A FOR LOOP
C  3. ELSE STORE FORWARD REFERENCE
C
C..NOTE - THE ACTUAL ARGUMENT USED IN CALLS TO THIS ROUTINE MAY
C         BE CONTAINED WITHIN COMMON BLOCKS IN THE CALLING SUB-
C         PROGRAM - THIS IS FLAGGED AS AN UNSAFE REFERENCE  BY
C         PFORT BUT IS ACTUALLY SAFE SINCE NONE OF THE ARGUMENTS
C         ARE CHANGED.
C
C..ARGUMENTS
      INTEGER STAT, DEST
C..LOCAL VARIABLES
      LOGICAL LTEMP
C..FUNCTIONS
      LOGICAL CHKFOR
      IF (STAT.NE.DEST) GO TO 10
      CALL ERROR(30HTRANSFER SETS UP INFINITE LOOP, 30)
      RETURN
C  IF STAT .GT. DEST WE HAVE A BACKWARD JUMP
   10 IF (STAT.LT.DEST) GO TO 20
      LTEMP=CHKFOR(.TRUE., STAT, DEST)
      IF (.NOT.LTEMP) CALL
     * ERROR(31HILLEGAL TRANSFER INTO FOR BLOCK, 31)
      RETURN
C  FORWARD JUMP STORE STAT AND DEST
   20 CALL UPJUMP(STAT, DEST)
      RETURN
      END
C***
C                    SUBROUTINE CHKSUB
C***
      SUBROUTINE CHKSUB(ICODE, NARGS)
C
C  CHECKS ARRAY/FUNCTION REFERENCE HAS CORRECT NUMBER
C  OF SUBSCRIPTS/ARGUMENTS
C
C   ICODE = CODE OF VARIABLE IN IVAR
C  NARGS = NUMBER OF SUBSCRIPTS/ARGUMENTS FOUND
C
C..ARGUMENTS
      INTEGER ICODE, NARGS
C..LOCAL VARIABLES
      INTEGER INA, INB, IPOS, RND, UDB
C..COMMON BLOCKS
      INTEGER ARRDIM, ARRSUB, ISFUN, FARG
      COMMON /CSARG/ ARRDIM(26,2), ARRSUB(26), ISFUN(11,3),
     * FARG(26)
      DATA INA, INB, UDB, RND /313,338,364,371/
C  NON-ANSI FUNCTION OR ARRAY
      IF (-1.EQ.ICODE) GO TO 90
C  TEST FOR NUMERIC ARRAY
      IF (ICODE.GT.INB) GO TO 20
C  ARRAY - GET POSITION IN ARRSUB
C  ERROR MESSAGE IF MORE THAN TWO SUBSCRIPTS
      IF (NARGS.GT.2) CALL
     * ERROR(43HARRAY MAY NOT HAVE MORE THAN TWO DIMENSIONS, 43)
      IPOS = ICODE - INA + 1
      IF (ARRSUB(IPOS).NE.0) GO TO 10
C  NOT SEEN BEFORE
      ARRSUB(IPOS) = -NARGS
      GO TO 90
C  SEEN BEFORE CHECKS ARGS
   10 IF (IABS(ARRSUB(IPOS)).NE.NARGS) GO TO 60
      GO TO 90
C  USER DEFINED FUNCTION
   20 IF (ICODE.GT.UDB) GO TO 50
C  ERROR MESSAGE IF MORE THAN ONE ARGUMENT
      IF (NARGS.GT.1) CALL
     * ERROR(38HFUNCTION MAY HAVE AT MOST ONE ARGUMENT, 38)
      IPOS = ICODE - INB
C  TEST IF IT HAS APPEARED BEFORE
      IF (-999.NE.FARG(IPOS)) GO TO 30
C NO
      FARG(IPOS) = -NARGS - 1
      GO TO 70
C  YES  IS PRE DEF USAGE
   30 IF (FARG(IPOS).GE.0) GO TO 40
C  YES - AGAIN CHECK NO CLASH
      IF (NARGS.NE.(-FARG(IPOS)-1)) CALL
     * ERROR(43HINCONSISTENT NUMBER OF SUBSCRIPTS/ARGUMENTS, 43)
      GO TO 70
C  NO - CHECK FOR CLASHES
   40 IF (NARGS.NE.FARG(IPOS)) GO TO 60
      GO TO 90
C  CHECK STANDARD FUNCTIONS
C  TEST FOR RND
   50 IF (ICODE.EQ.RND) GO TO 80
      IF (NARGS.EQ.1) GO TO 90
      GO TO 60
C  ERROR EXITS
C  1) INCONSISTENT NUMBER OF SUBSCRIPTS/ARGUMENTS
   60 CALL ERROR(43HINCONSISTENT NUMBER OF SUBSCRIPTS/ARGUMENTS,
     * 43)
      GO TO 90
C  2)FUNCTION USED BEFORE IT APPEARS IN A DEF STATEMENT
   70 CALL ERROR(34HFUNCTION USED BEFORE IT IS DEFINED, 34)
      GO TO 90
C  3) RND DOES NOT HAVE AN ARGUMENTS
   80 CALL ERROR(27HRND SHOULD HAVE NO ARGUMENT, 27)
   90 RETURN
      END
C***
C                    SUBROUTINE CLASFY
C***
      SUBROUTINE CLASFY(CLASS, ERR)
C
C  ROUTINE TO CLASIFY A BASIC STATEMENT BY ITS KEYWORD
C  IF NON-STANDARD KEYWORD THEN CLASS IS SET TO 21
C  ERR IS SET .TRUE. IF SPACES OCCUR WITHIN THE KEYWORD
C             .FALSE. OTHERWISE
C
C..ARGUMENTS
      INTEGER CLASS
      LOGICAL ERR
C..LOCAL VARIABLES
      INTEGER J, SPACE
      LOGICAL LTEMP
C..FUNCTIONS
      LOGICAL EATSP
C..COMMON BLOCKS
      INTEGER LLINE, NLINE, MAXLIN, LINE
      INTEGER K3, JCODE
      INTEGER KALP, KFAL, KSUC
      COMMON /CLINE/ LLINE, NLINE, MAXLIN, LINE(80)
      COMMON /CNXTCH/ K3, JCODE
      COMMON /CTREE/ KALP(72), KSUC(72), KFAL(72)
      DATA SPACE /44/
C  START OF SEARCH FOR KEYWORDS
      ERR = .FALSE.
      J = 1
   10 IF (LINE(K3).EQ.KALP(J)) GO TO 20
C  NO MATCH - LOOK FOR NEXT NODE IN FAIL TREE
      J = KFAL(J)
C  IF J<0 THEN NON-ANSI KEYWORD
      IF (J) 60, 60, 10
C  SUCCESSFUL MATCH - LOOK AT NEXT NODE IN SUCCESS TREE
   20 J = KSUC(J)
      IF (J.LT.0) GO TO 50
C   SUCCESSFUL MATCH - NEED TO LOOK AT NEXT NON-BLANK
   30 K3 = K3 + 1
C  RUN OUT OF LINE - ERROR EXIT
      IF (K3.LE.NLINE) GO TO 40
      J = -21
      GO TO 60
   40 IF (LINE(K3).NE.SPACE) GO TO 10
C  BLANK IN KEYWORD - SET ERROR FLAG AND GET NEXT CHARACTER
      ERR = .TRUE.
      GO TO 30
C  SUCCESSFUL MATCH CHECK FOR GOTO OR GOSUB
   50 IF (-21.NE.J) GO TO 60
C  SPACES ARE ALLOWED BETWEEN GO AND TO  AND   GO AND SUB
      J = K3 + 1
      LTEMP = EATSP(J,K3)
      J = 68
      GO TO 10
C EXIT - NEGATE CLASS AND RETURN
   60 CLASS = -J
      RETURN
      END
C***
C                    INTEGER FUNCTION CODE
C***
      INTEGER FUNCTION CODE(I)
C
C  RETURNS THE CODE OF THE CHARACTER IN LINE(I)
C    DIGIT=1     LETTER=2      SPECIAL CHARACTER=3
C
C..ARGUMENTS
      INTEGER I
C..COMMON BLOCKS
      INTEGER LLINE, NLINE, MAXLIN, LINE
      COMMON /CLINE/ LLINE, NLINE, MAXLIN, LINE(80)
      IF (LINE(I).GT.9) GO TO 10
C DIGIT
      CODE = 1
      GO TO 30
   10 IF (LINE(I).GT.35) GO TO 20
C  LETTER
      CODE = 2
      GO TO 30
C  SPECIAL CHARACTER
   20 CODE = 3
   30 RETURN
      END
C***
C                    INTEGER FUNCTION CODECH
C***
      INTEGER FUNCTION CODECH(CHAR, ERR)
C
C  ROUTINE CODECH MAPS THE CHARACTER CHAR INTO ITS INTERNAL CODE
C  IF A NON-ANSI CHARACTER IS FOUND THE CODE IS SET TO SPACE
C  AND ERR IS SET TO .TRUE.
C
C..ARGUMENTS
      INTEGER CHAR
      LOGICAL ERR
C..LOCAL VARIABLES
      INTEGER ICODE(60), LET(60)
      INTEGER I, LENGTH
      DATA LENGTH /60/
      DATA LET(2), ICODE(2) /1H0,0/
      DATA LET(5), ICODE(5) /1H1,1/
      DATA LET(17), ICODE(17) /1H2,2/
      DATA LET(21), ICODE(21) /1H3,3/
      DATA LET(23), ICODE(23) /1H4,4/
      DATA LET(20), ICODE(20) /1H5,5/
      DATA LET(25), ICODE(25) /1H6,6/
      DATA LET(32), ICODE(32) /1H7,7/
      DATA LET(36), ICODE(36) /1H8,8/
      DATA LET(28), ICODE(28) /1H9,9/
      DATA LET(14), ICODE(14) /1HA,10/
      DATA LET(26), ICODE(26) /1HB,11/
      DATA LET(34), ICODE(34) /1HC,12/
      DATA LET(19), ICODE(19) /1HD,13/
      DATA LET(4), ICODE(4) /1HE,14/
      DATA LET(15), ICODE(15) /1HF,15/
      DATA LET(38), ICODE(38) /1HG,16/
      DATA LET(27), ICODE(27) /1HH,17/
      DATA LET(6), ICODE(6) /1HI,18/
      DATA LET(42), ICODE(42) /1HJ,19/
      DATA LET(29), ICODE(29) /1HK,20/
      DATA LET(10), ICODE(10) /1HL,21/
      DATA LET(22), ICODE(22) /1HM,22/
      DATA LET(7), ICODE(7) /1HN,23/
      DATA LET(8), ICODE(8) /1HO,24/
      DATA LET(18), ICODE(18) /1HP,25/
      DATA LET(44), ICODE(44) /1HQ,26/
      DATA LET(9), ICODE(9) /1HR,27/
      DATA LET(16), ICODE(16) /1HS,28/
      DATA LET(3), ICODE(3) /1HT,29/
      DATA LET(33), ICODE(33) /1HU,30/
      DATA LET(41), ICODE(41) /1HV,31/
      DATA LET(49), ICODE(49) /1HW,32/
      DATA LET(30), ICODE(30) /1HX,33/
      DATA LET(43), ICODE(43) /1HY,34/
      DATA LET(39), ICODE(39) /1HZ,35/
C  PLUS  ASCII 2/11
      DATA LET(40), ICODE(40) /1H+,36/
C  MINUS  ASCII 2/13
      DATA LET(35), ICODE(35) /1H-,37/
C  CLOSE  ASCII 2/9
      DATA LET(11), ICODE(11) /1H),38/
C  EQUALS ASCII 3/13
      DATA LET(13), ICODE(13) /1H=,39/
C  PERIOD ASCII 2/14
      DATA LET(47), ICODE(47) /1H.,40/
C  OPEN  ASCII 2/8
      DATA LET(12), ICODE(12) /1H(,41/
C  ASTERISK  ASCII 2/10
      DATA LET(31), ICODE(31) /1H*,42/
C  SLANT  ASCII 2/15
      DATA LET(48), ICODE(48) /1H/,43/
C  SPACE  ASCII 2/0
      DATA LET(1), ICODE(1) /1H ,44/
C  LESS - THAN  ASCII 3/12
      DATA LET(46), ICODE(46) /1H<,45/
C  GREATER - THAN  ASCII 3/14
      DATA LET(51), ICODE(51) /1H>,46/
C  CIRCUMFLEX  ASCII 5/14
      DATA LET(58), ICODE(58) /1H?,47/
C  QUOTE  ASCII 2/2
      DATA LET(24), ICODE(24) /1H",48/
C  EXCLAMATION - POINT 2/1
      DATA LET(53), ICODE(53) /1H],49/
C  NUMBER - SIGN  ASCII 2/3
      DATA LET(55), ICODE(55) /1H#,50/
C  DOLLAR  ASCII 2/4
      DATA LET(45), ICODE(45) /1H$,51/
C  PERCENT  ASCII 2/5
      DATA LET(59), ICODE(59) /1H%,52/
C  AMPERSAND  ASCII 2/6
      DATA LET(57), ICODE(57) /1H&,53/
C  APOSTROPHE  ASCII 2/7
      DATA LET(54), ICODE(54) /1H',54/
C  COLON  ASCII 3/10
      DATA LET(52), ICODE(52) /1H:,55/
C  SEMI - COLON  ASCII 3/11
      DATA LET(50), ICODE(50) /1H;,56/
C  QUESTION - MARK  ASCII 3/15
      DATA LET(60), ICODE(60) /1H?,57/
C  UNDERLINE  ASCII 5/15
      DATA LET(56), ICODE(56) /1H?,58/
C  COMMA  ASCII 2/12
      DATA LET(37), ICODE(37) /1H,,59/
C
C  LOOK FOR STANDARD CONFORMING CHARACTER
C
      DO 10 I=1,LENGTH
        IF (LET(I).EQ.CHAR) GO TO 20
   10 CONTINUE
C
C  NOT FOUND SET TO SPACE AND RETURN BLANK
C
      CODECH = 44
      ERR = .TRUE.
      GO TO 30
C
C  FOUND
C
   20 CODECH = ICODE(I)
   30 RETURN
      END
C***
C                    INTEGER FUNCTION CODVAR
C***
      INTEGER FUNCTION CODVAR(ICODE)
C
C  THIS FUNCTION CODES A VARIABLE STORED IN TOKEN(1 - NTOK)
C  GIVING ITS POSITION IN THE ARRAY IVAR
C
C  ICODE = 1  - SIMPLE VARIABLE
C          2  - STRING VARIABLE
C          3  - NUMERICAL ARRAY
C          4  - USER DEFINED FUNCTION
C          5  - STANDARD FUNCTION
C          6  - TAB FUNCTION
C
C..ARGUMENTS
      INTEGER ICODE
C..LOCAL VARIABLES
      INTEGER TAB(4)
      INTEGER A, F, I, IS1, IS2, IS3, IS4, IT, J, N, NOFUN,
     * TABCOD, Z
C..COMMON BLOCKS
      INTEGER ARRDIM, ARRSUB, ISFUN, FARG
      INTEGER NTOK, LTOK, TOKEN
      COMMON /CSARG/ ARRDIM(26,2), ARRSUB(26), ISFUN(11,3),
     * FARG(26)
      COMMON /CTOKEN/ LTOK, NTOK, TOKEN(72)
      DATA F, N, A, Z /15,23,10,35/
      DATA TAB(1), TAB(2), TAB(3), TAB(4), TABCOD
     * /29,10,11,41,376/
      DATA IS1, IS2, IS3, IS4 /287,313,339,365/
      DATA NOFUN /11/
      GO TO (10, 20, 30, 40, 50, 80), ICODE
C  SIMPLE VARIABLE
   10 IF (NTOK.EQ.1) IT = -1
      IF (NTOK.EQ.2 .AND. TOKEN(2).GT.9) GO TO 100
      IF (NTOK.EQ.2) IT = TOKEN(2)
      CODVAR = (TOKEN(1)-10)*11 + IT + 2
      GO TO 110
C  STRING VARIABLE
   20 CODVAR = IS1 + (TOKEN(1)-10)
      GO TO 110
C  ARRAY VARIABLE
   30 CODVAR = IS2 + (TOKEN(1)-10)
      GO TO 110
C  FUNCTION
C  USER DEFINED (F=15,N=23)
   40 IF (TOKEN(1).NE.F .OR. TOKEN(2).NE.N) GO TO 100
C  NEXT LETTER MUST BE IN THE RANGE A-Z
      IF (TOKEN(3).LT.A .OR. TOKEN(3).GT.Z) GO TO 100
      CODVAR = IS3 + (TOKEN(3)-10)
      GO TO 110
C  SEARCH STANDARD FUNCTIONS
   50 DO 70 I=1,NOFUN
        DO 60 J=1,3
          IF (TOKEN(J).NE.ISFUN(I,J)) GO TO 70
   60   CONTINUE
C  MATCH
        CODVAR = IS4 + I - 1
        GO TO 110
   70 CONTINUE
      GO TO 100
C  TAB FUNCTION
   80 IF (NTOK.NE.4) GO TO 100
      DO 90 I=1,4
        IF (TOKEN(I).NE.TAB(I)) GO TO 100
   90 CONTINUE
      CODVAR = TABCOD
      GO TO 110
C  NO MATCH
  100 CODVAR = 0
  110 RETURN
      END
C***
C                    SUBROUTINE DATA
C***
      SUBROUTINE DATA
C
C  CHECKS DATA STATEMENT
C
C  THE DATA ROUTINE JUST CHECKS THAT EACH ITEM IN THE LIST
C  IS EITHER A QUOTED STRING OR AN UNQUOTED STRING. SINCE
C  IT IS NOT POSSIBLE TO KNOW WHETHER THE OBJECTS WILL BE
C  ASSIGNED TO NUMBERS OR NOT NO NUMERICAL CHECKS ARE PERFORMED
C
C..LOCAL VARIABLES
      INTEGER COMMA, K, K1, MAXLEN, QUOTE
      LOGICAL LTEMP
C..FUNCTIONS
      INTEGER CODE, QSTRG
      LOGICAL EATSP
C..COMMON BLOCKS
      INTEGER K3, JCODE
      INTEGER LLINE, NLINE, MAXLIN, LINE
      COMMON /CNXTCH/ K3, JCODE
      COMMON /CLINE/ LLINE, NLINE, MAXLIN, LINE(80)
      DATA COMMA, QUOTE /59,48/
C  MAXLEN SPECIFIED MAX STRING LENGTH
      DATA MAXLEN /18/
   10 JCODE = CODE(K3)
      IF (LINE(K3).NE.QUOTE) GO TO 20
C  QUOTED STRING
      IF (QSTRG(K).GT.MAXLEN) CALL
     * ERROR(54HWARNING QUOTED STRING EXCEEDS MAXIMUM SPECIFIED LENGTH,
     * 54)
      GO TO 30
C  OTHERWISE ASSUME UNQUOTED STRING
   20 CALL UQSTR
   30 IF (-1.EQ.K3) GO TO 50
      IF (LINE(K3).EQ.COMMA) GO TO 40
      CALL
     * ERROR(53HNO COMMA WHERE ONE EXPECTED REST OF STATEMENT IGNORED,
     * 53)
      GO TO 50
C  EAT COMMA AND LOOK FOR NEXT DATUM
   40 K1 = K3 + 1
      LTEMP = EATSP(K1,K3)
C  IF END OF LINE ERROR
      IF (-1.NE.K3) GO TO 10
      CALL ERROR(32HDANGLING COMMA IN DATA STATEMENT, 32)
   50 RETURN
      END
C***
C                    SUBROUTINE DCODE
C***
      SUBROUTINE DCODE(CH, ICODE)
C
C  GIVEN A VARIABLE / ARRAY / FUNCTION CODE - ICODE - RETURNS
C  A HOLLERITH STRING OF LENGTH THREE IN CH
C
C..ARGUMENTS
      INTEGER CH(3)
      INTEGER ICODE
C..LOCAL VARIABLES
      INTEGER LET(26), NUM(10), U(7)
      INTEGER DOLLAR, I, IBLNK, ILET, JCODE
C..COMMON BLOCKS
      INTEGER ARRDIM, ARRSUB, ISFUN, FARG
      COMMON /CSARG/ ARRDIM(26,2), ARRSUB(26), ISFUN(11,3),
     * FARG(26)
      DATA LET(1), LET(2), LET(3), LET(4) /1HA,1HB,1HC,1HD/
      DATA LET(5), LET(6), LET(7), LET(8) /1HE,1HF,1HG,1HH/
      DATA LET(9), LET(10), LET(11), LET(12) /1HI,1HJ,1HK,1HL/
      DATA LET(13), LET(14), LET(15), LET(16) /1HM,1HN,1HO,1HP/
      DATA LET(17), LET(18), LET(19), LET(20) /1HQ,1HR,1HS,1HT/
      DATA LET(21), LET(22), LET(23), LET(24) /1HU,1HV,1HW,1HX/
      DATA LET(25), LET(26) /1HY,1HZ/
      DATA NUM(1), NUM(2), NUM(3), NUM(4) /1H0,1H1,1H2,1H3/
      DATA NUM(5), NUM(6), NUM(7), NUM(8) /1H4,1H5,1H6,1H7/
      DATA NUM(9), NUM(10) /1H8,1H9/
      DATA U(1), U(2), U(3), U(4), U(5), U(6), U(7)
     * /1,286,312,338,364,375,376/
      DATA IBLNK /1H /, DOLLAR /1H$/
      CH(3) = IBLNK
      CH(2) = IBLNK
      IF (ICODE.GT.U(2)) GO TO 10
C  SIMPLE VARIABLE - CALCULATE LETTER AND DIGIT PARTS
      ILET = (ICODE-1)/11
      CH(1) = LET(ILET+1)
C  BLANK IF REMAINDER IS -1
      ILET = (ICODE-2) - ILET*11
      IF (-1.NE.ILET) CH(2) = NUM(ILET+1)
      GO TO 70
C  STRING VARIABLE
   10 IF (ICODE.GT.U(3)) GO TO 20
      JCODE = ICODE - U(2)
      CH(1) = LET(JCODE)
      CH(2) = DOLLAR
      GO TO 70
C  NUMERICAL ARRAY
   20 IF (ICODE.GT.U(4)) GO TO 30
      JCODE = ICODE - U(3)
      CH(1) = LET(JCODE)
      GO TO 70
C  USER DEFINED FUNCTION
   30 IF (ICODE.GT.U(5)) GO TO 40
      JCODE = ICODE - U(4)
      CH(3) = LET(JCODE)
      CH(2) = LET(14)
      CH(1) = LET(6)
      GO TO 70
C  STANDARD FUNCTION
   40 IF (ICODE.GT.U(6)) GO TO 60
      ILET = ICODE - U(5)
      DO 50 I=1,3
        JCODE = ISFUN(ILET,I)
        CH(I) = LET(JCODE-9)
   50 CONTINUE
      GO TO 70
C  TAB
   60 CH(1) = LET(20)
      CH(2) = LET(1)
      CH(3) = LET(2)
      GO TO 70
   70 RETURN
      END
C***
C                    SUBROUTINE DEF
C***
      SUBROUTINE DEF
C
C  SUBROUTINE ANALYSES DEF STATEMENTS
C
C..LOCAL VARIABLES
      INTEGER ARGS, COMMA, EQUALS, FCODE, I, INB, IPOS, K1, K2,
     * LPAREN, RPAREN
      LOGICAL LTEMP
C..FUNCTIONS
      INTEGER CODE
      LOGICAL EATSP, FLSHCH
C..COMMON BLOCKS
      INTEGER NUMST, NUMERR, LABENO
      LOGICAL ENDERR, LABERR
      LOGICAL ERR, SIMPST
      INTEGER TCODE, TYPE, VCODE, ENDEXP
      INTEGER LLINE, NLINE, MAXLIN, LINE
      INTEGER K3, JCODE
      INTEGER NREF, REF
      INTEGER ARRDIM, ARRSUB, ISFUN, FARG
      INTEGER LSTAT, NSTAT, BNSTAT, STATNO, STAREF
      INTEGER NTOK, LTOK, TOKEN
      INTEGER LVAR, IVAR
      COMMON /CERROR/ NUMST, NUMERR, ENDERR, LABENO, LABERR
      COMMON /CEXPR/ TCODE, TYPE, ERR, VCODE, ENDEXP, SIMPST
      COMMON /CLINE/ LLINE, NLINE, MAXLIN, LINE(80)
      COMMON /CNXTCH/ K3, JCODE
      COMMON /CREFER/ NREF, REF(40)
      COMMON /CSARG/ ARRDIM(26,2), ARRSUB(26), ISFUN(11,3),
     * FARG(26)
      COMMON /CSTAT/ LSTAT, NSTAT, BNSTAT, STATNO(500),
     * STAREF(500,2)
      COMMON /CTOKEN/ LTOK, NTOK, TOKEN(72)
      COMMON /CVAR/ LVAR, IVAR(376,2)
      DATA INB, LPAREN, RPAREN, EQUALS, COMMA /338,41,38,39,59/
C  GET FUNCTION NAME AND CHECK THAT IT IS LEGAL
      NREF = 0
      ENDEXP = NLINE
      CALL NEXTOK
      IF (K3.GT.ENDEXP .OR. TCODE.NE.2) GO TO 160
      IF (TYPE.EQ.4) GO TO 10
C  ILEGAL FUNCTION NAME
      CALL ERROR(26HNON-STANDARD FUNCTION NAME, 26)
C  CHECK IF LEFT PAREN - IF SO CARRY ON CHECKING SUBSCRIPTS
      FCODE = 0
      GO TO 20
C  LEGAL FUNCTION NAME - SET VARIABLES - CHECK NO SPACES
C  SAVE FUNCTION CODE FOR ELEMENTARY RECURSION CHECK
C  VCODE = 0  IF FUNCTION IS ILLEGAL
   10 IPOS = VCODE - INB
      FCODE = VCODE
      IF (ERR) CALL
     * ERROR(37HSPACES NOT PERMITTED IN VARIABLE NAME, 37)
C  ANALYZE ARGUMENT LIST IF ONE EXISTS
   20 ARGS = 0
      IF (TOKEN(NTOK).NE.LPAREN) GO TO 60
C  NEXT TOKEN SHOULD BE A SIMPLE NUMERIC VARIABLE
   30 CALL NEXTOK
C  IF NOT S.N. VARIABLE THEN FLUSH TO EQUALS
      IF (TYPE.EQ.1 .AND. TCODE.EQ.2) GO TO 40
C  ERROR NOT A SIMPLE VARIABLE AS ARGUMENT - FLUSH TO EQUALS
      CALL ERROR(32HARGUMENT MUST BE SIMPLE VARIABLE, 32)
      GO TO 70
   40 IF (ERR) CALL
     * ERROR(37HSPACES NOT PERMITTED IN VARIABLE NAME, 37)
      ARGS = ARGS + 1
C  ADD DUMMY ARGUMENT TO CHAIN
      CALL REFCHK
C  CHECK FOR END OF LINE
      IF (K3.GT.NLINE) GO TO 160
C  CHECK FOR END OF ARGUMENT LIST
      IF (LINE(K3).NE.RPAREN) GO TO 50
C  END OF ARGUMENT LIST - EAT SPACES TO NEXT NON-BLANK
      K2 = K3 + 1
      LTEMP = EATSP(K2,K3)
      IF (-1.EQ.K3) GO TO 160
      GO TO 60
C  CHECK IF COMMA NEXT - IF SO GET NEXT ARGUMENT (ILLEGAL)
   50 IF (LINE(K3).NE.COMMA) GO TO 70
      K2 = K3 + 1
      LTEMP = EATSP(K2,K3)
      IF (-1.EQ.K3) GO TO 160
      JCODE = CODE(K3)
      GO TO 30
C  NEXT CHARACTER EQUALS - YES THEN CHECK EXPRESSION
   60 IF (LINE(K3).EQ.EQUALS) GO TO 80
C  OUTPUT ERROR MESSAGE AND FLUSH TO EQUALS
   70 IF (.NOT.FLSHCH(K3,EQUALS)) GO TO 170
      CALL ERROR(35HSYNTAX ERROR CHECKING RESTARTS AT =, 35)
C  EQUALS FOUND - GET NEXT NON-BLANK
   80 K2 = K3 + 1
      LTEMP = EATSP(K2,K3)
      IF (-1.EQ.K3) GO TO 160
      IF (ARGS.GT.1) CALL
     * ERROR(
     * 48HONLY ONE ARGUMENT ALLOWED IN FUNCTION DEFINITION, 48)
C  CHECK IF FUNCTION REDEFINED (FARG(IPOS) POSITIVE)
C  OR USED BEFORE DEFINITION (FARG(IPOS) NOT EQUAL -999)
C  SKIP TESTS IF ILLEGAL FUNCTION HAS BEEN FOUND
      IF (FCODE.EQ.0) GO TO 110
      IF (FARG(IPOS).LT.0) GO TO 90
      CALL ERROR(29HFUNCTION MAY NOT BE REDEFINED, 29)
      GO TO 110
   90 IF (-999.EQ.FARG(IPOS)) GO TO 100
      CALL ERROR(40HFUNCTION HAS BEEN USED BEFORE DEFINITION,
     * 40)
C  IN THIS CASE TEST FOR CONFLICTING NUMBER OF ARGUMENTS
      IF (ARGS.NE.IABS(FARG(IPOS)+1)) CALL
     * ERROR(
     * 50HNUMBER OF ARGUMENTS IN PREVIOUS CALLS INCONSISTENT,
     * 50)
C  UPDATE FARG WITH DEFINED NUMBER OF ARGUMENTS (ARGS)
  100 FARG(IPOS) = ARGS
C  NOW ANALYSE EXPRESSION
  110 K1 = K3
      CALL EXPRES(K1, NLINE, -1, .TRUE.)
C  CANNOT HAVE SIMPLE STRING ON R.H.S.
      IF (SIMPST) CALL
     * ERROR(37HILLEGAL R.H.S. OF FUNCTION DEFINITION, 37)
C  CHECK NO OBVIOUS RECURSION
      IF (FCODE.EQ.0 .OR. NREF.EQ.0) GO TO 130
      DO 120 I=1,NREF
        IF (FCODE.EQ.REF(I)) CALL
     *   ERROR(24HRECURSION IS NOT ALLOWED, 24)
  120 CONTINUE
C  ADD REFERENCES TO CHAIN
  130 IF (FCODE.EQ.0) GO TO 140
      VCODE = FCODE
      CALL REFCHK
  140 IF (NREF.EQ.0) GO TO 180
      DO 150 I=1,NREF
        CALL ADDREF(IVAR, LVAR, LABENO, REF(I))
  150 CONTINUE
      GO TO 180
C  ERRORS
C  1)SYNTAX ERRORS - IGNORE REST OF STATEMENT
  160 CALL ERROR(38HSYNTAX ERROR REST OF STATEMENT IGNORED, 38)
      GO TO 180
C  2)UNRECOVERABLE ERROR AFTER ATTEMPTED FLUSH TO EQUALS
  170 CALL ERROR(26H= NOT FOUND WHERE EXPECTED, 26)
      CALL ERROR(25HREST OF STATEMENT IGNORED, 25)
  180 RETURN
      END
C***
C                    SUBROUITNE DIM
C***
      SUBROUTINE DIM
C
C  ANALYZES DIM STATEMENTS
C
C..LOCAL VARIABLES
      INTEGER AROFST, COMMA, I, IPOS, K, K1, LPAREN, RPAREN,
     * SUBS
      LOGICAL ERR, LTEMP
C..FUNCTIONS
      INTEGER CODE, LTOINT
      LOGICAL EATSP, FLSHRP
C..COMMON BLOCKS
      INTEGER NUMST, NUMERR, LABENO
      LOGICAL ENDERR, LABERR
      LOGICAL EXPERR, SIMPST
      INTEGER TCODE, TYPE, VCODE, ENDEXP
      LOGICAL ABNFOR
      INTEGER LFOR, NFOR, FORNXT, LJUMP, NJUMP, JUMPS
      INTEGER LLINE, NLINE, MAXLIN, LINE
      INTEGER K3, JCODE
      LOGICAL DIMYET, OPTYET
      INTEGER OPTSET
      INTEGER NREF, REF
      INTEGER ARRDIM, ARRSUB, ISFUN, FARG
      INTEGER NTOK, LTOK, TOKEN
      INTEGER LVAR, IVAR
      COMMON /CERROR/ NUMST, NUMERR, ENDERR, LABENO, LABERR
      COMMON /CEXPR/ TCODE, TYPE, EXPERR, VCODE, ENDEXP, SIMPST
      COMMON /CFOR1/ LFOR, NFOR, FORNXT(50,2), LJUMP, NJUMP,
     * JUMPS(500,2), ABNFOR
      COMMON /CLINE/ LLINE, NLINE, MAXLIN, LINE(80)
      COMMON /CNXTCH/ K3, JCODE
      COMMON /COPT/ DIMYET, OPTYET, OPTSET
      COMMON /CREFER/ NREF, REF(40)
      COMMON /CSARG/ ARRDIM(26,2), ARRSUB(26), ISFUN(11,3),
     * FARG(26)
      COMMON /CTOKEN/ LTOK, NTOK, TOKEN(72)
      COMMON /CVAR/ LVAR, IVAR(376,2)
      DATA LPAREN, RPAREN, COMMA /41,38,59/
      DATA AROFST /312/
C  INITIALIZATION
      DIMYET = .TRUE.
      NREF = 0
      ENDEXP = NLINE
   10 SUBS = 1
      CALL NEXTOK
      IPOS = VCODE - AROFST
C  TEST IF NO OPENING BRACKET
      IF (TOKEN(NTOK).NE.LPAREN) GO TO 100
C  TEST IF LEGAL ARRAY
      IF (TYPE.EQ.3) GO TO 20
C  BRACKET IN TOKEN(NTOK) BUT NON-ANSI ARRAY
C  FLUSH TO MATCHING CLOSING BRACKET
      CALL ERROR(29HILLEGAL NAME IN DIM STATEMENT, 29)
      K1 = K3
      IF (.NOT.FLSHRP(K1)) GO TO 90
      GO TO 70
C  HAVE GOT LEGAL NUMERIC ARRAY - ADD TO REFERENCE CHAIN
   20 NREF = NREF + 1
      REF(NREF) = VCODE
C  NOTE NEXTOK HAS MOVED K3 TO THE NEXT NON-BLANK
C  TEST FOR END OF LINE
      IF (K3.GT.NLINE) GO TO 110
C  TEST IF NEXT IS A DIGIT
   30 IF (JCODE.EQ.1) GO TO 40
C  IF NOT FLUSH TO NEXT )
      CALL ERROR(28HDIMENSION MUST BE AN INTEGER, 28)
      K1 = K3
      IF (.NOT.FLSHRP(K1)) GO TO 90
      GO TO 70
C  GET INTEGER AND ADD TO ARRDIM
   40 CALL INTEG(ERR)
      IF (ERR) CALL
     * ERROR(44HSPACES NOT PERMITTED WITHIN INTEGER CONSTANT,
     * 44)
C  ADD IN INTEGER TO ARRDIM IF SUBS LE 2
      IF (SUBS.EQ.1 .AND. ARRDIM(IPOS,1).NE.(-1)) CALL
     * ERROR(37HREDIMENSIONING OF AN ARRAY IS ILLEGAL, 37)
      IF (SUBS.LE.2) ARRDIM(IPOS,SUBS) = LTOINT(K)
C  INTEG RETURNS NEXT NON-BLANK AND ITS CODE
      IF (-1.EQ.K3) GO TO 110
C  TEST FOR COMMA
      IF (LINE(K3).NE.COMMA) GO TO 50
C  YES - LOOK FOR ANOTHER DIMENSION
      SUBS = SUBS + 1
      K1 = K3 + 1
      LTEMP = EATSP(K1,K3)
      IF (-1.EQ.K3) GO TO 110
      JCODE = CODE(K3)
      GO TO 30
C  NO - END OF ARRAY - REQUIRE RIGHT PARENTHESIS
   50 IF (LINE(K3).EQ.RPAREN) GO TO 60
C  TRY TO FLUSH TO RIGHT PARENTHESIS
      CALL ERROR(28HNO ) OR , WHERE ONE EXPECTED, 28)
      K1 = K3
      IF (.NOT.FLSHRP(K1)) GO TO 90
      GO TO 70
C  FINISHED RECORD NUMBER OF SUBSCRIPTS
C  CHECK ,IF USED BEFORE DIMENSIONING, NUMBER OF ARGUMENTS
C  IS CONSISTENT
   60 IF (ARRSUB(IPOS).NE.0) CALL
     * ERROR(47HARRAY USED PRIOR TO APPEARANCE IN DIM STATEMENT,
     * 47)
      IF (ARRSUB(IPOS).LT.0 .AND. ARRSUB(IPOS).NE.(-SUBS)) CALL
     * ERROR(43HINCONSISTENT NUMBER OF SUBSCRIPTS/ARGUMENTS, 43)
      ARRSUB(IPOS) = SUBS
      IF (SUBS.GT.2) CALL
     * ERROR(37HARRAY MAY HAVE AT MOST TWO DIMENSIONS, 37)
      GO TO 80
C  RECOVERABLE ERROR
   70 K3 = K1
      CALL ERROR(23HRECOVERED AT MATCHING ), 23)
   80 K1 = K3 + 1
      LTEMP = EATSP(K1,K3)
C  CLEAN EXIT
      IF (-1.EQ.K3) GO TO 120
C  OTHERWISE NEED SEPARATOR ,
      IF (LINE(K3).NE.COMMA) GO TO 110
C  GET NEXT NON-BLANK
      K1 = K3 + 1
      LTEMP = EATSP(K1,K3)
      IF (-1.EQ.K3) GO TO 110
      JCODE = CODE(K3)
C  GET NEXT ARRAY
      GO TO 10
C  ERROR EXITS
C   1)UNRECOVERABLE ERROR
   90 CALL ERROR(41HUNRECOVERABLE - REST OF STATEMENT IGNORED,
     * 41)
      GO TO 120
C   2)NON ARRAY
  100 CALL
     * ERROR(
     * 52HNON-SUBSCRIPTED VARIABLE - REST OF STATEMENT IGNORED,
     * 52)
      GO TO 120
C   3) SYNTAX ERROR IN STATEMENT
  110 CALL ERROR(37HDIM STATEMENT SYNTACTICALLY INCORRECT, 37)
      GO TO 120
C  ADD REFERENCES TO CHAIN
  120 IF (NREF.EQ.0) GO TO 140
      DO 130 I=1,NREF
        CALL ADDREF(IVAR, LVAR, LABENO, REF(I))
  130 CONTINUE
  140 RETURN
      END
C***
C                    LOGICAL FUNCTION EATSP
C***
      LOGICAL FUNCTION EATSP(K1, K2)
C
C  EATSP  EATS SPACES
C
C  ON ENTRY
C         K1 = POSITION OF START OF SEARCH IN ARRAY LINE
C  ON EXIT
C         K2 = POSITION OF FIRST NON-BLANK CHARACTER IN LINE
C              -1 IF NONE  (I.E. REST OF LINE IS BLANK)
C      EATSP =  .TRUE.  IF SPACES FOUND
C            =  .FALSE. IF NO SPACES HAVE BEEN FOUND
C
C..ARGUMENTS
      INTEGER K1, K2
C..LOCAL VARIABLES
      INTEGER J, K4, SPACE
C..COMMON BLOCKS
      INTEGER LLINE, NLINE, MAXLIN, LINE
      COMMON /CLINE/ LLINE, NLINE, MAXLIN, LINE(80)
      DATA SPACE /44/
      EATSP = .FALSE.
C  CHECK NOT AT END OF LINE
      IF (K1.GT.NLINE) GO TO 20
      K2 = K1
      IF (LINE(K1).NE.SPACE) GO TO 30
C  AT LEAST ONE SPACE FOUND
      EATSP = .TRUE.
      K2 = K1 + 1
      K4 = K2
      DO 10 J=K4,NLINE
        IF (LINE(J).NE.SPACE) GO TO 30
        K2 = K2 + 1
   10 CONTINUE
C  END OF LINE IF FALL THROUGH DO LOOP
      EATSP = .FALSE.
C  COME HERE IF K1 .GT. NLINE (NOTE EATSP = .FALSE.)
   20 K2 = -1
   30 RETURN
      END
C***
C                    SUBROUTINE ERROR
C***
      SUBROUTINE ERROR(MESS, NMESS)
C
C  OUTPUT ROUTINE FOR ERROR MESSAGES
C  NOUT IS THE OUTPUT CHANNEL NUMBER
C  NUMERR IS THE NUMBER OF ERROR MESSAGES SO FAR OUTPUT
C  MACHINE DEPENDENT CONSTANT , NOCHAR , THE NUMBER OF
C    CHARACTERS STORED IN AN INTEGER.
C  A CHANGE IN THE VALUE OF NOCHAR WILL ALSO NECESSITATE
C  A CHANGE IN THE FORMAT STATEMENT 99999
C  A MORE REFINED OUTPUT MAY BE OBTAINED BY INCLUDING THE COMMON BLOCK
C      COMMON /CNXTCH/ K3,JCODE
C  IN THE EVENT OF AN ERROR K3 USUALLY HOLDS THE CHARACTER POSITION
C  IN THE LINE CLOSE TO WHERE THE ERROR OCCURRED.
C
C..ARGUMENTS
      INTEGER MESS(20)
      INTEGER NMESS
C..LOCAL VARIABLES
      INTEGER I, NOCHAR, NWORD
C..COMMON BLOCKS
      INTEGER NUMST, NUMERR, LABENO
      LOGICAL ENDERR, LABERR
      INTEGER NIN, NOUT, NTAB
      LOGICAL ENDIN
      COMMON /CERROR/ NUMST, NUMERR, ENDERR, LABENO, LABERR
      COMMON /CIO/ NIN, NOUT, NTAB, ENDIN
      DATA NOCHAR /4/
      NUMERR = NUMERR + 1
      NWORD = NMESS/NOCHAR
      IF (NWORD*NOCHAR.NE.NMESS) NWORD = NWORD + 1
      WRITE (NOUT,99999) (MESS(I),I=1,NWORD)
      RETURN
99999 FORMAT (1H , 3H***, 20A4)
      END
C***
C                    SUBROUTINE EXPRES
C***
      SUBROUTINE EXPRES(K1, K2, LEVEL, STRING)
C
C  ANALYZES A BASIC EXPRESSION STARTING AT LINE(K1) AND
C  ENDING AT LINE(K2).  IF LEVEL IS SET POSITIVE EXIT IS
C  MADE FROM THE ROUTINE WHEN THAT LEVEL OF CLOSING
C  PARENTHESIS IS ENCOUNTERED.
C  IF STRING IS SET TRUE ON ENTRY - A SEARCH IS INITIALLY
C  MADE FOR A SIMPLE STRING VARIABLE OR A QUOTED STRING -
C  ALL THAT IS ALLOWED AS A STRING EXPRESSION - IN ANSI
C  BASIC.
C  THE ROUTINE ATTEMPTS TO ANALYSE AS MUCH OF THE EXPRESSION
C  AS POSSIBLE.
C
C..ARGUMENTS
      INTEGER K1, K2, LEVEL
      LOGICAL STRING
C..LOCAL VARIABLES
      INTEGER COMMA, I, ICH, ICODE, K, K4, KCODE, KEEP, LPAREN, MAXLEN,
     * MINUS, PERIOD, PLUS, QUOTE, RND, RPAREN, SLASH, SPACE, STAR,
     * STUSED, WORRA
      LOGICAL ERR, LTEMP
C..FUNCTIONS
      INTEGER CODE, QSTRG
      LOGICAL EATSP
C..COMMON BLOCKS
      INTEGER ARPOS, ARSTAK, DLPREQ, LARST, LPOPEN, NEXT1
      LOGICAL ERREXP, SIMPST
      INTEGER TCODE, TYPE, VCODE, ENDEXP
      INTEGER LLINE, NLINE, MAXLIN, LINE
      INTEGER K3, JCODE
      INTEGER NTOK, LTOK, TOKEN
      COMMON /CARFUN/ LARST, ARSTAK(40,3), NEXT1, LPOPEN, DLPREQ, ARPOS
      COMMON /CEXPR/ TCODE, TYPE, ERREXP, VCODE, ENDEXP, SIMPST
      COMMON /CLINE/ LLINE, NLINE, MAXLIN, LINE(80)
      COMMON /CNXTCH/ K3, JCODE
      COMMON /CTOKEN/ LTOK, NTOK, TOKEN(72)
C  MAXLEN IS MAXIMUM STRING LENGTH
      DATA RND, MAXLEN, PERIOD /371,18,40/
      DATA QUOTE, PLUS, MINUS, SPACE, LPAREN /48,36,37,44,41/
      DATA STAR, WORRA, SLASH, RPAREN, COMMA /42,47,43,38,59/
      SIMPST = .FALSE.
      ERR = .FALSE.
C  INITIALIZE
      ENDEXP = K2
      IF (LEVEL.LT.0) NEXT1 = 1
      LPOPEN = 0
      IF (LEVEL.GT.0) LPOPEN = LEVEL
      STUSED = 0
C  SAVE K3 AND JCODE AND FIND FIRST NON-BLANK IN EXPRESSION
      KEEP = K3
      KCODE = JCODE
      LTEMP = EATSP(K1,K3)
      IF (K3.GT.K2 .OR. (-1).EQ.K3) GO TO 250
      JCODE = CODE(K3)
C  IF STRING EXPRESSION REQUIRED - KEEP STARTING POSITION
      IF (.NOT.STRING) GO TO 40
      K4 = K3
      ICODE = JCODE
C  IF JCODE.EQ.3 IT MUST BE A QUOTE - ELSE TRY MORE COMPLEX EXPRESSION
      IF (JCODE.NE.3) GO TO 20
      IF (LINE(K3).NE.QUOTE) GO TO 30
      I = QSTRG(K)
C  K4+K+1 IS THE POSITION OF THE FINAL QUOTE
C  IF CLOSING QUOTE NOT FOUND IN EXPRESSION RANGE - GIVE UP
C  NOTE - ERROR MESSAGE HAS ALREADY BEEN OUTPUT FROM QSTRG
      IF ((-1.EQ.K3 .AND. K.LT.0) .OR. (K4+K+1.GT.K2)) GO TO 220
C  CHECK AT END OF EXPRESSION
      IF (-1.EQ.K3) GO TO 10
      IF (K3.LE.K2) GO TO 30
C  SUCCESSFUL STRING EXPRESSION - CHECK MAXLEN
   10 IF (K.GT.MAXLEN) CALL
     * ERROR(54HWARNING QUOTED STRING EXCEEDS MINIMAL SPECIFIED LENGTH,
     * 54)
      SIMPST = .TRUE.
      GO TO 280
C  IF JCODE.EQ.1 - NUMBER - CANNOT BE STRING
   20 IF (JCODE.EQ.1) GO TO 30
C  ALPHABETIC - NEXT TOKEN
      CALL NEXTOK
C  MUST BE A LEGAL STRING VARIABLE AND AT END OF EXPRESSION
      IF (TYPE.NE.2 .OR. K3.NE.K2+1) GO TO 30
C  LEGAL STRING PREPARE FOR EXIT - ERROR MESSAGE
C  IF SPACES IN STRING VARIABLE
      IF (ERREXP) CALL ERROR(37HSPACES NOT PERMITTED IN VARIABLE NAME,
     * 37)
C  ADD REFERENCE TO REFERENCE ARRAY
      CALL REFCHK
      SIMPST = .TRUE.
      GO TO 280
C  RESET START OF EXPRESSION AND TREAT AS COMPLEX EXPRESSION
   30 K3 = K4
      JCODE = ICODE
C  EAT UP SIGN AND OPENING BRACKETS
   40 IF (LINE(K3).NE.PLUS .AND. LINE(K3).NE.MINUS) GO TO 70
C  EAT IT AND SPACES
   50 K3 = K3 + 1
      IF (K3.GT.K2) GO TO 220
      IF (LINE(K3).NE.SPACE) GO TO 60
      GO TO 50
   60 JCODE = CODE(K3)
C  OPENING BRACKET
   70 IF (LINE(K3).NE.LPAREN) GO TO 90
      LPOPEN = LPOPEN + 1
C  EAT SPACES
   80 K3 = K3 + 1
      IF (K3.GT.K2) GO TO 220
      IF (LINE(K3).EQ.SPACE) GO TO 80
      JCODE = CODE(K3)
      GO TO 40
C  TEST IF QUOTED STRING
   90 IF (LINE(K3).NE.QUOTE) GO TO 100
C  IF ALREADY HAD A QUOTED STRING OR OTHER STRING THEN GIVE UP
      K4 = K3
C  TEST IF QUOTED STRING IS LEGAL
      I = QSTRG(K)
      IF ((-1.EQ.K) .OR. (K4+K+1.GT.K2)) GO TO 220
C  CHECK MAX LENGTH
      IF (K.GT.MAXLEN) CALL
     * ERROR(46HQUOTED STRING EXCEEDS MINIMAL SPECIFIED LENGTH, 46)
      STUSED = STUSED + 1
C  CHECK IF END OF LINE
      GO TO 130
C  TEST IF PERIOD COULD BE A NUMBER
  100 IF (LINE(K3).EQ.PERIOD) GO TO 110
C  IF JCODE.EQ.3 NOW THEN ERROR
      IF (JCODE.EQ.3) GO TO 230
C  GET NEXT TOKEN
  110 CALL NEXTOK
      IF (ERREXP .OR. (ERR .AND. TCODE.EQ.1)) CALL
     * ERROR(53HSPACES NOT PERMITTED IN NUMBER/VARIABLE/FUNCTION NAME,
     * 53)
      ERR = .FALSE.
C TEST IF STRING (TCODE=2 AND TYPE=2) AND ARPOS.NE.0 (ARRAY
C SUBSCRIPT OR FUNCTION ARGUMENT BEING PARSED)
      IF ((TCODE.EQ.2 .AND. TYPE.EQ.2) .AND. ARPOS.NE.0) CALL
     * ERROR(29HILLEGAL SUBSCRIPT OR ARGUMENT, 29)
C  TEST IF NUMBER
      IF (TCODE.EQ.1 .AND. TYPE.EQ.(-1)) GO TO 220
      IF (TCODE.EQ.1) GO TO 130
C  TEST IF ILLEGAL VARIABLE / FUNCTION
      IF (TYPE.LT.0) CALL ERROR(30HILLEGAL VARIABLE/FUNCTION NAME, 30)
C  TEST IF SIMPLE VARIABLE - NO ( IN TOKEN(NTOK)
      IF (TOKEN(NTOK).NE.LPAREN) GO TO 120
C  ADD TOKEN TO ARSTAK
      LPOPEN = LPOPEN + 1
      CALL ARWIND(.FALSE.)
      IF (VCODE.GT.0) CALL REFCHK
C  CAN NOW HAVE AN EXPRESSION AS ARRAY SUBSCRIPT OR FUNCTION
C  ARGUMENT. N.B. JCODE AND K3 HAVE BEEN SET BY NEXTOK
      GO TO 40
C  SIMPLE VARIABLE CHECK
C  ADD CODE INTO ARRAY REF IF IT DOESNOT ALREADY EXIST
  120 IF (TYPE.GT.0) CALL REFCHK
C  CHECK IF FUNCTION WITH NO ARGUMENTS THAT THIS IS CONSISTENT AND
C  THAT FUNCTION HAS BEEN PREVIOUSLY DEFINED
      IF (TCODE.EQ.2 .AND. (TYPE.EQ.3 .OR. TYPE.EQ.4)) CALL
     * CHKSUB(VCODE, 0)
C  CHECK THAT IF TYPE=5 THE FUNCTION IS RND
C  NO OTHER STANDARD FUNCTIONS HAVE NO ARGUMENTS
      IF (TYPE.EQ.5 .AND. VCODE.NE.RND) CALL
     * ERROR(42HSTANDARD FUNCTION CALLED WITHOUT ARGUMENTS, 42)
C  CHECK IF STRING LEGAL OR OTHERWISE
      IF (IABS(TYPE).EQ.2) STUSED = STUSED + 1
C  CHECK IF END OF EXPRESSION
  130 IF (K3.GT.K2 .OR. (-1).EQ.K3) GO TO 260
C  CHECK FOR CLOSING BRACKET - EATING SPACES
      IF (LINE(K3).NE.SPACE) GO TO 140
      K3 = K3 + 1
      GO TO 130
  140 IF (LINE(K3).NE.RPAREN) GO TO 170
C  CLOSING BRACKET FOUND
      LPOPEN = LPOPEN - 1
C  CHECK MISMATCHED PARENTHESES
      IF (LPOPEN.GE.0) GO TO 150
      CALL ERROR(22HMISMATCHED PARENTHESES, 22)
      GO TO 240
C  CLOSE DOWN ARRAY/FUNCTION AS NECESSARY
  150 IF (LPOPEN.EQ.DLPREQ-1) CALL ARWIND(.TRUE.)
C  EXIT IF MATCHING BRACKET FOUND
      IF (LPOPEN.EQ.LEVEL-1) GO TO 160
C  CHECK FOR MORE RIGHT PARENTHESES
      K3 = K3 + 1
      GO TO 130
C  MATCHING RIGHT PAREN IN LINE(K3) - FIND NEXT NON BLANK AND EXIT
  160 K4 = K3 + 1
      LTEMP = EATSP(K4,K3)
      IF (-1.NE.K3) JCODE = CODE(K3)
      GO TO 290
C  TEST IF PLUS,MINUS,UP ARROW ,STAR OR SLASH
  170 ICH = LINE(K3)
      IF (ICH.NE.PLUS .AND. ICH.NE.MINUS .AND. ICH.NE.STAR .AND.
     * ICH.NE.SLASH .AND. ICH.NE.WORRA) GO TO 190
C  EAT IT BUT CANT HAVE END OF LINE
  180 K3 = K3 + 1
      IF (K3.GT.K2) GO TO 220
      IF (LINE(K3).EQ.SPACE) GO TO 180
      JCODE = CODE(K3)
      GO TO 70
C COMMA
  190 IF (LINE(K3).NE.COMMA) GO TO 220
C  UPDATE NUMBER OF SUBSCRIPTS / ARGUMENTS
C  IF NONE OPEN THEN ERROR
      IF (ARPOS.NE.0) GO TO 200
      CALL ERROR(48HCOMMA FOUND BUT NO ARRAYS/FUNCTIONS OPEN-IGNORED,
     * 48)
      GO TO 40
  200 ARSTAK(ARPOS,3) = ARSTAK(ARPOS,3) + 1
  210 K3 = K3 + 1
      IF (K3.GT.K2) GO TO 220
      IF (LINE(K3).EQ.SPACE) GO TO 210
      JCODE = CODE(K3)
      GO TO 40
C  ERROR EXIT - MISPLACED DELIMITER OF OPERATOR
  220 K3 = K2
  230 CALL ERROR(42HMISPLACED OR ILLEGAL DELIMITER OR OPERATOR, 42)
  240 CALL ERROR(26HREST OF EXPRESSION IGNORED, 26)
      GO TO 270
  250 CALL ERROR(37HEXPRESSION MISSING WHERE ONE EXPECTED, 37)
      GO TO 270
C  CLEAN EXIT CHECK FOR MISMATCHED PARENTHESES
  260 IF (LPOPEN.NE.0) CALL ERROR(25HMISSING RIGHT PARENTHESES, 25)
  270 IF (STUSED.GT.1) CALL
     * ERROR(44HNON-STANDARD USE OF STRING VARIABLE/FUNCTION, 44)
  280 K3 = KEEP
      JCODE = KCODE
  290 RETURN
      END
C***
C                    LOGICAL FUNCTION FLSHCH
C***
      LOGICAL FUNCTION FLSHCH(K1, CHAR)
C
C  TRUE IF CHAR FOUND - POSITION IN K1
C  FALSE IF NOT FOUND
C  K1 IS START OF SEARCH POSITION ON ENTRY
C
C..ARGUMENTS
      INTEGER CHAR, K1
C..COMMON BLOCKS
      INTEGER LLINE, NLINE, MAXLIN, LINE
      COMMON /CLINE/ LLINE, NLINE, MAXLIN, LINE(80)
      FLSHCH = .TRUE.
   10 IF (K1.GT.NLINE) GO TO 20
      IF (LINE(K1).EQ.CHAR) GO TO 30
      K1 = K1 + 1
      GO TO 10
   20 FLSHCH = .FALSE.
   30 RETURN
      END
C***
C                    LOGICAL FUNCTION FLSHRP
C***
      LOGICAL FUNCTION FLSHRP(K1)
C
C  TRUE IF MATCHING RIGHT PARENTHESIS FOUND
C  POSITION IN K1 - FALSE IF NOT FOUND
C  K1 IS THE POSITION OF START OF SEARCH
C
C..ARGUMENTS
      INTEGER K1
C..LOCAL VARIABLES
      INTEGER LPAREN, LPOPEN, RPAREN
C..COMMON BLOCKS
      INTEGER LLINE, NLINE, MAXLIN, LINE
      COMMON /CLINE/ LLINE, NLINE, MAXLIN, LINE(80)
      DATA LPAREN, RPAREN /41,38/
      LPOPEN = 1
      FLSHRP = .TRUE.
   10 IF (K1.GT.NLINE) GO TO 40
      IF (LINE(K1).NE.RPAREN) GO TO 20
C  CLOSING BRACKET
      LPOPEN = LPOPEN - 1
      IF (LPOPEN.EQ.0) GO TO 50
      GO TO 30
C  OPEN BRACKETS
   20 IF (LINE(K1).NE.LPAREN) GO TO 30
      LPOPEN = LPOPEN + 1
   30 K1 = K1 + 1
      GO TO 10
   40 FLSHRP = .FALSE.
   50 RETURN
      END
C***
C                    SUBROUTINE FORST
C***
      SUBROUTINE FORST
C
C  CHECK FOR STATEMENT
C
C..LOCAL VARIABLES
      INTEGER STEP(5), TO(3)
      INTEGER EQUALS, I, IREF, K1, K2, K4, SPACE
      LOGICAL ERR, LSPACE, LTEMP
C..FUNCTIONS
      INTEGER CODVAR
      LOGICAL CHKKEY, EATSP
C..COMMON BLOCKS
      INTEGER LDO, DOPEN, DOSPEC
      INTEGER NUMST, NUMERR, LABENO
      LOGICAL ENDERR, LABERR
      LOGICAL ERREXP, SIMPST
      INTEGER TCODE, TYPE, VCODE, ENDEXP
      LOGICAL ABNFOR
      INTEGER LFOR, NFOR, FORNXT, LJUMP, NJUMP, JUMPS
      INTEGER LLINE, NLINE, MAXLIN, LINE
      INTEGER K3, JCODE
      INTEGER NREF, REF
      INTEGER LVAR, IVAR
      COMMON /CDO/ LDO, DOPEN, DOSPEC(30)
      COMMON /CERROR/ NUMST, NUMERR, ENDERR, LABENO, LABERR
      COMMON /CEXPR/ TCODE, TYPE, ERREXP, VCODE, ENDEXP, SIMPST
      COMMON /CFOR1/ LFOR, NFOR, FORNXT(50,2), LJUMP, NJUMP,
     * JUMPS(500,2), ABNFOR
      COMMON /CLINE/ LLINE, NLINE, MAXLIN, LINE(80)
      COMMON /CNXTCH/ K3, JCODE
      COMMON /CREFER/ NREF, REF(40)
      COMMON /CVAR/ LVAR, IVAR(376,2)
      DATA EQUALS, SPACE /39,44/
      DATA TO(1), TO(2), TO(3) /29,24,2/
      DATA STEP(1), STEP(2), STEP(3), STEP(4), STEP(5)
     * /28,29,14,25,4/
C  INITIALIZE
      ERR = .FALSE.
      LSPACE = .FALSE.
      NREF = 0
C  USE NEXTOK TO PICK UP NEXT TOKEN
      ENDEXP = NLINE
      CALL NEXTOK
C  CHECK SIMPLE VARIABLE
      IF (TCODE.EQ.2 .AND. TYPE.EQ.1) GO TO 40
C  NOT A SIMPLE VARIABLE
      CALL
     * ERROR(45HSIMPLE NUMERIC VARIABLE MUST CONTROL FOR LOOP,
     * 45)
C  FLUSH TO = (39) IN AN ATTEMPT TO RECOVER
C  CHECK RETURN FROM NEXTOK NOT AT END OF STATEMENT
      IF (K3.GT.NLINE) GO TO 20
      K1 = K3
      DO 10 I=K1,NLINE
        IF (LINE(I).EQ.EQUALS) GO TO 30
   10 CONTINUE
C  NO = FOUND  GIVE UP
   20 CALL ERROR(41HUNRECOVERABLE - REST OF STATEMENT IGNORED,
     * 41)
      GO TO 150
C  RECOVER START AT = SIGN   JUMP DOSPEC
   30 CALL ERROR(22HCHECKING RESTARTS AT =, 22)
      K3 = I
      GO TO 80
C  SIMPLE VARIABLE FOUND - CHECK NO SPACES
   40 NREF = 1
      REF(NREF) = CODVAR(1)
      IF (ERREXP) CALL
     * ERROR(37HSPACES NOT PERMITTED IN VARIABLE NAME, 37)
C  ADD VARIABLE TO DOSPEC ARRAY
C  CHECK VARIABLE HAS NOT BEEN USED MORE THAN ONCE
C  IN NESTED FOR-LOOPS
      IF (DOPEN.EQ.0) GO TO 60
      IREF = REF(NREF)
      DO 50 I=1,DOPEN
        IF (DOSPEC(I).NE.IREF) GO TO 50
        CALL
     *   ERROR(42HNESTED FOR-LOOP CONTROL VARIABLES THE SAME,
     *   42)
        GO TO 70
   50 CONTINUE
C  CHECK NOT MORE THAN LDO ALREADY OPEN
      IF (LDO.EQ.DOPEN) CALL SYSERR(3)
   60 DOPEN = DOPEN + 1
      DOSPEC(DOPEN) = REF(NREF)
C  ADD LABEL INTO FORNXT ARRAY
      NFOR = NFOR + 1
      IF (NFOR.GT.LFOR) CALL SYSERR(6)
      FORNXT(NFOR,1) = LABENO
C  NEXTOK HAS RETURNED A SIMPLE VARIABLE BUT NO MORE CHARACTERS ON LINE
   70 IF (K3.GT.NLINE) GO TO 110
C  CHECK = SIGN (39)
      IF (LINE(K3).NE.EQUALS) GO TO 110
   80 K1 = K3 + 1
      LTEMP = EATSP(K1,K3)
      IF (-1.EQ.K3) GO TO 100
C  CHECK KEYWORD EXISTS
      IF (.NOT.(CHKKEY(TO,TO(3),K1,K2))) GO TO 120
C  CHECK PRECEDED BY A SPACE
      IF (LINE(K1-1).NE.SPACE) ERR = .TRUE.
C  CHECK DOES NOT CONTAIN SPACES
      IF (K2-K1.NE.1) LSPACE = .TRUE.
C  IF AT END OF LINE  - ERROR - NO EXPRESSION FOLLOWS KEYWORD OR =
      IF (K2.EQ.NLINE) GO TO 100
C  CHECK SPACE FOLLOWS KEYWORD
      IF (LINE(K2+1).NE.SPACE) ERR = .TRUE.
C  CHECK EXPRESSION FROM AFTER = (K3) TO KEYWORD
      K4 = K3
      CALL EXPRES(K4, K1-1, -1, .FALSE.)
C  OUTPUT ANY ERRORS REGARDING KEYWORD TO
      K3 = K2 - 1
      IF (ERR) CALL
     * ERROR(38HSPACES MUST PRECEDE AND FOLLOW KEYWORD, 38)
      IF (LSPACE) CALL
     * ERROR(33HSPACES NOT ALLOWED WITHIN KEYWORD, 33)
C  REINITIALIZE SPACE AND ERR
      LSPACE = .FALSE.
      ERR = .FALSE.
C  K2 POINTS AT END OF TO - LOOK FOR STEP KEYWORD
      K1 = K2 + 1
      IF (.NOT.(CHKKEY(STEP,STEP(5),K1,K4))) GO TO 90
C  KEYWORD APPEARS CHECK SPACES
      IF (LINE(K1-1).NE.SPACE) ERR = .TRUE.
      IF (K4-K1.NE.3) LSPACE = .TRUE.
C  IF AT END OF LINE ERROR AS WITH TO
      IF (K4.EQ.NLINE) GO TO 100
      IF (LINE(K4+1).NE.SPACE) ERR = .TRUE.
C  CHECK EXPRESSION FOLLOWING TO
      CALL EXPRES(K2+1, K1-1, -1, .FALSE.)
C OUTPUT ANY SPACE ERRORS IN STEP
      K3 = K4 - 1
      IF (LSPACE) CALL
     * ERROR(33HSPACES NOT ALLOWED WITHIN KEYWORD, 33)
      IF (ERR) CALL
     * ERROR(38HSPACES MUST PRECEDE AND FOLLOW KEYWORD, 38)
C  CHECK EXPRESSION FOLLOWING STEP
      CALL EXPRES(K4+1, NLINE, -1, .FALSE.)
      GO TO 130
C  NO STEP KEYWORD JUST CHECK TO EXPRESSION
   90 CALL EXPRES(K2+1, NLINE, -1, .FALSE.)
      GO TO 130
C  ERROR EXITS
C  1)FOR MISSING KEYWORDS - MAY HAVE REFERENCES
  100 CALL ERROR(34HNO EXPRESSION FOLLOWS KEYWORD OR =, 34)
      GO TO 130
C  2)MISSING = SIGN
  110 CALL
     * ERROR(47HDELIMITER = MISSING - REST OF STATEMENT IGNORED,
     * 47)
      GO TO 150
C  3)KEYWORD TO MISSING
  120 CALL ERROR(39HKEYWORD TO ABSENT - STATEMENT ABANDONED, 39)
      GO TO 150
C  ADD VARIABLE REFERENCES TO CHAIN
  130 IF (NREF.EQ.0) GO TO 150
      DO 140 I=1,NREF
        CALL ADDREF(IVAR, LVAR, LABENO, REF(I))
  140 CONTINUE
  150 RETURN
      END
C***
C                    SUBROUTINE GOTOS
C***
      SUBROUTINE GOTOS
C
C  CHECKS GOTO (7) AND GOSUB(6) STATEMENTS TO ENSURE
C      A)SPACE FOLLOWS KEYWORD
C      B)STATEMENT NUMBER ONLY ON REST OF LINE
C
C  K3 CONTAINS THE POSITION OF THE NEXT NON-BLANK
C  AND JCODE ITS CODE
C
C..LOCAL VARIABLES
      INTEGER K, MAXSNO, REF
      LOGICAL ERR
C..FUNCTIONS
      INTEGER LTOINT
C..COMMON BLOCKS
      INTEGER NUMST, NUMERR, LABENO
      LOGICAL ENDERR, LABERR
      INTEGER LLINE, NLINE, MAXLIN, LINE
      INTEGER K3, JCODE
      COMMON /CERROR/ NUMST, NUMERR, ENDERR, LABENO, LABERR
      COMMON /CLINE/ LLINE, NLINE, MAXLIN, LINE(80)
      COMMON /CNXTCH/ K3, JCODE
      DATA MAXSNO /9999/
C  CHECK NEXT DIGIT AN INTEGER
      IF (JCODE.NE.1) GO TO 10
C  INTEGER - GET NUMERICAL STRING
      CALL INTEG(ERR)
C  SPACES IN STATEMENT NUMBER
      IF (ERR) CALL
     * ERROR(38HSPACES NOT ALLOWED IN STATEMENT NUMBER, 38)
      REF = LTOINT(K)
      IF (REF.GT.MAXSNO) CALL
     * ERROR(44HSTATEMENT NUMBER EXCEEDS MINIMAL REQUIREMENT,
     * 44)
      IF (REF.EQ.0) GO TO 10
      CALL ADDSTA(REF)
      CALL CHKREF(LABENO, REF)
C  TEST NO MORE INFO ON LINE
      IF (-1.NE.K3) CALL
     * ERROR(
     * 53HEXTRANEOUS INFORMATION FOLLOWING GOTO/GOSUB STATEMENT,
     * 53)
      GO TO 20
   10 CALL ERROR(35HMISSING OR ILLEGAL STATEMENT NUMBER, 35)
   20 RETURN
      END
C***
C                    SUBROUTINE IFST
C***
      SUBROUTINE IFST
C
C
C  ANALYZES IF STATEMENTS OF THE FORM
C
C    IF  EXPR1 REL. OP. EXPR2  THEN INTEGER
C
C..LOCAL VARIABLES
      INTEGER THEN(5)
      INTEGER EQUALS, GREAT, I, K, K1, K2, K4, LESS, LL, SPACE
      LOGICAL ERR, LTEMP, STRING
C..FUNCTIONS
      INTEGER CODE, LTOINT
      LOGICAL CHKKEY, EATSP
C..COMMON BLOCKS
      INTEGER NUMST, NUMERR, LABENO
      LOGICAL ENDERR, LABERR
      LOGICAL ERREXP, SIMPST
      INTEGER TCODE, TYPE, VCODE, ENDEXP
      LOGICAL ABNFOR
      INTEGER LFOR, NFOR, FORNXT, LJUMP, NJUMP, JUMPS
      INTEGER LLINE, NLINE, MAXLIN, LINE
      INTEGER K3, JCODE
      INTEGER NREF, REF
      INTEGER LSTAT, NSTAT, BNSTAT, STATNO, STAREF
      INTEGER LVAR, IVAR
      COMMON /CERROR/ NUMST, NUMERR, ENDERR, LABENO, LABERR
      COMMON /CEXPR/ TCODE, TYPE, ERREXP, VCODE, ENDEXP, SIMPST
      COMMON /CFOR1/ LFOR, NFOR, FORNXT(50,2), LJUMP, NJUMP,
     * JUMPS(500,2), ABNFOR
      COMMON /CLINE/ LLINE, NLINE, MAXLIN, LINE(80)
      COMMON /CNXTCH/ K3, JCODE
      COMMON /CREFER/ NREF, REF(40)
      COMMON /CSTAT/ LSTAT, NSTAT, BNSTAT, STATNO(500), STAREF(500,2)
      COMMON /CVAR/ LVAR, IVAR(376,2)
      DATA THEN(1), THEN(2), THEN(3), THEN(4), THEN(5) /29,17,14,23,4/
      DATA GREAT, LESS, EQUALS, SPACE /46,45,39,44/
C  FIRST NON-BLANK (START OF EXPR1) IN K1
C  THEN LOOK FOR RELATIONAL OPERATOR
      NREF = 0
      K1 = K3
      K2 = K3
   10 LL = LINE(K2)
      IF (LL.EQ.GREAT .OR. LL.EQ.EQUALS .OR. LL.EQ.LESS) GO TO 20
      K2 = K2 + 1
      IF (K2.GT.NLINE) GO TO 100
      GO TO 10
C  RELATIONAL FOUND - ANALYZE EXPRESSION 1  (K2-1 IS PREVIOUS
C  CHARACTER TO REL. OP.)
   20 K2 = K2 - 1
      CALL EXPRES(K1, K2, -1, .TRUE.)
C  SAVE SIMPST
      STRING = SIMPST .AND. LL.EQ.EQUALS
      LTEMP = EATSP(K2+2,K3)
      IF (-1.EQ.K3) GO TO 100
      IF (LL.EQ.EQUALS) GO TO 50
C  NOW CHECK FOR SECOND OPERATOR
      IF (LL.NE.GREAT) GO TO 30
C  COULD HAVE EQUALS FOLLOWING
      IF (LINE(K3).EQ.EQUALS) GO TO 40
C  COULD HAVE EQUALS OR GREATER FOLLOWING LESS
   30 IF (LINE(K3).NE.EQUALS .AND. LINE(K3).NE.GREAT) GO TO 50
C  IF SIMPLE STRING THEN REQUIRE EITHER EQUALITY OR NON-EQUALITY
      STRING = (LL.EQ.LESS .AND. LINE(K3).EQ.GREAT .AND. SIMPST) .OR.
     * (STRING)
C  SECOND OPERATOR HAS BEEN FOUND - OUTPUT ERROR MESSAGE IF SPACES
C  EXIST WITHIN THE OPERATOR (LTEMP)
   40 IF (LTEMP) CALL
     * ERROR(
     * 58HSPACES NOT ALLOWED WITHIN MULTICHARACTER RELATIONAL SYMBOL,
     * 58)
C  SET K3 FOR START OF NEW EXPRESSION - TEST FOR FOLLOWING SPACE
      K3 = K3 + 1
C  LOOK FOR THEN KEYWORD - K1 IS START OF EXPR2
   50 K1 = K3
      K2 = K3
      IF (.NOT.CHKKEY(THEN,THEN(5),K2,K4)) GO TO 100
C  ANALYZE EXPR2
      CALL EXPRES(K1, K2-1, -1, .TRUE.)
C  FINISH LEGAL STRING COMPARISON CHECK
C  IF STRING AND SIMPST BOTH TRUE OR BOTH FALSE THEN LEGAL STRING
      IF ((STRING .AND. SIMPST) .OR. ((.NOT.STRING) .AND.
     * (.NOT.SIMPST))) GO TO 60
      CALL ERROR(25HILLEGAL STRING EXPRESSION, 25)
C  ADD REFERENCES TO CHAIN
   60 IF (NREF.NE.0) GO TO 70
      CALL ERROR(48HWARNING - NO VARIABLES IN RELATIONAL EXPRESSIONS,
     * 48)
      GO TO 90
   70 DO 80 I=1,NREF
        CALL ADDREF(IVAR, LVAR, LABENO, REF(I))
   80 CONTINUE
C  CHECK SPACES EITHER SIDE OF THEN BUT NONE INSIDE
   90 IF (K4+1.GT.NLINE) GO TO 100
      LTEMP = EATSP(K4+1,K3)
      IF (LINE(K2-1).NE.SPACE .OR. (.NOT.LTEMP)) CALL
     * ERROR(38HSPACES MUST PRECEDE AND FOLLOW KEYWORD, 38)
      IF (K4-K2+1.NE.THEN(5)) CALL
     * ERROR(33HSPACES NOT ALLOWED WITHIN KEYWORD, 33)
C  SPACES ALREADY EATEN BY EATSP ABOVE JCODE MUST BE 1 NOW
      IF (CODE(K3).NE.1) GO TO 110
      CALL INTEG(ERR)
      IF (ERR) CALL ERROR(38HSPACES NOT ALLOWED IN STATEMENT NUMBER, 38)
C  CHECK AT END OF STATEMENT
      IF (-1.NE.K3) CALL
     * ERROR(47HEXTRANEOUS INFORMATION FOLLOWS STATEMENT NUMBER, 47)
C  ADD INTEGER TO CHAIN AND EXIT (SUCCESSFULLY)
C  CHECK TRANSFER IS LEGAL
      K1 = LTOINT(K)
      CALL ADDSTA(K1)
      CALL CHKREF(LABENO, K1)
      GO TO 120
C  ERROR EXITS
C   1) SYNTAX ERROR IN STATEMENT
  100 CALL ERROR(25HSYNTAX ERROR IN STATEMENT, 25)
      GO TO 120
C   2) STATEMENT NUMBER DOES NOT FOLLOW THEN
  110 CALL ERROR(33HSTATEMENT NUMBER MUST FOLLOW THEN, 33)
  120 RETURN
      END
C***
C                    SUBROUTINE INREAD
C***
      SUBROUTINE INREAD
C
C  ANALYSES INPUT AND READ STATEMENTS
C
C..LOCAL VARIABLES
      INTEGER COMMA, I, K1, K2, LPAREN, OPEN, RPAREN
      LOGICAL ERR1, LTEMP
C..FUNCTIONS
      INTEGER CODE
      LOGICAL EATSP
C..COMMON BLOCKS
      INTEGER NUMST, NUMERR, LABENO
      LOGICAL ENDERR, LABERR
      LOGICAL ERR, SIMPST
      INTEGER TCODE, TYPE, VCODE, ENDEXP
      INTEGER LLINE, NLINE, MAXLIN, LINE
      INTEGER K3, JCODE
      INTEGER NREF, REF
      INTEGER NTOK, LTOK, TOKEN
      INTEGER LVAR, IVAR
      COMMON /CERROR/ NUMST, NUMERR, ENDERR, LABENO, LABERR
      COMMON /CEXPR/ TCODE, TYPE, ERR, VCODE, ENDEXP, SIMPST
      COMMON /CLINE/ LLINE, NLINE, MAXLIN, LINE(80)
      COMMON /CNXTCH/ K3, JCODE
      COMMON /CREFER/ NREF, REF(40)
      COMMON /CTOKEN/ LTOK, NTOK, TOKEN(72)
      COMMON /CVAR/ LVAR, IVAR(376,2)
      DATA LPAREN, RPAREN, COMMA /41,38,59/
      NREF = 0
C  GET A VARIABLE FROM THE LIST
   10 K1 = K3
      ERR1 = .FALSE.
      ENDEXP = NLINE
      CALL NEXTOK
C  TEST IF LEGAL - IF DOESNOT START WITH A LETTER GIVE UP
      IF (TCODE.NE.2) GO TO 110
      IF (TYPE.EQ.1 .OR. TYPE.EQ.2 .OR. TYPE.EQ.3) GO TO 20
C  ILLEGAL VARIABLE FLUSH TO NEXT TOP LEVEL COMMA
      CALL ERROR(35HILLEGAL VARIABLE IN INPUT/READ LIST, 35)
      K2 = K1
      ERR1 = .TRUE.
      OPEN = 0
      GO TO 30
C  DEAL WITH SUBSCRIPT  ETC
   20 IF (TOKEN(NTOK).NE.LPAREN) GO TO 70
      OPEN = 1
      K2 = K3 - 1
C  FLUSH TO NEXT TOP LEVEL COMMA
   30 K2 = K2 + 1
      IF (OPEN.NE.0) GO TO 40
      IF (K2.GT.NLINE) GO TO 50
      IF (LINE(K2).EQ.COMMA) GO TO 50
C  COMMA NOT FOUND - TEST FOR OPENING AND CLOSING BRACKETS
   40 IF (K2.GT.NLINE) GO TO 100
      IF (LINE(K2).EQ.LPAREN) OPEN = OPEN + 1
      IF (LINE(K2).EQ.RPAREN) OPEN = OPEN - 1
      GO TO 30
C  FOUND - IF NO ERROR FLAG SET THEN ANALYZE EXPRESSION FROM START (K1)
C          SUBSCRIPTED VARIABLE IS THUS ADDED TO LIST
   50 IF (ERR1) GO TO 60
      CALL EXPRES(K1, K2-1, -1, .FALSE.)
   60 LTEMP = EATSP(K2,K3)
      IF (-1.EQ.K3) GO TO 120
      GO TO 80
C  SIMPLE VARIABLE ADD TO REF AND CHECK SPACES
   70 CALL REFCHK
      IF (ERR) CALL
     * ERROR(37HSPACES NOT PERMITTED IN VARIABLE NAME, 37)
      IF (K3.GT.NLINE) GO TO 120
C  NEXT SHOULD BE A COMMA - ELSE FLUSH TO NEXT TOP LEVEL COMMA
   80 IF (LINE(K3).EQ.COMMA) GO TO 90
C  OTHERWISE FLUSH TO COMMA
      CALL ERROR(32HSYNTAX ERROR FLUSH TO NEXT COMMA, 32)
      K2 = K3
      ERR1 = .TRUE.
      OPEN = 0
      GO TO 30
C  GET NEXT NON-BLANK - CANNOT BE END OF LINE
   90 LTEMP = EATSP(K3+1,K3)
      IF (-1.EQ.K3) GO TO 110
      JCODE = CODE(K3)
      GO TO 10
C  ERRORS
C    1) SYNTAX ERRORS
  100 K3 = K2
  110 CALL ERROR(40HSYNTAX ERROR - REST OF STATEMENT IGNORED,
     * 40)
  120 IF (NREF.EQ.0) GO TO 140
      DO 130 I=1,NREF
        CALL ADDREF(IVAR, LVAR, LABENO, REF(I))
  130 CONTINUE
  140 RETURN
      END
C***
C                    SUBROUTINE INSTAT
C***
      SUBROUTINE INSTAT
C
C  INSTAT READS IN A STATEMENT ,CHECKS FOR END OF INPUT,
C  OUTPUTS THE STATEMENT,CODES THE STATEMENT AND OUTPUTS
C  ANY ERROR MESSAGES CONCERNING NON-STANDARD CHARACTERS
C
C..LOCAL VARIABLES
      INTEGER I, IDOT, MXLIN1, SPACE
      LOGICAL ERR
C..FUNCTIONS
      INTEGER CODECH
C..COMMON BLOCKS
      INTEGER NUMST, NUMERR, LABENO
      LOGICAL ENDERR, LABERR
      INTEGER NIN, NOUT, NTAB
      LOGICAL ENDIN
      INTEGER LLINE, NLINE, MAXLIN, LINE
      INTEGER K3, JCODE
      COMMON /CERROR/ NUMST, NUMERR, ENDERR, LABENO, LABERR
      COMMON /CIO/ NIN, NOUT, NTAB, ENDIN
      COMMON /CLINE/ LLINE, NLINE, MAXLIN, LINE(80)
      COMMON /CNXTCH/ K3, JCODE
      DATA IDOT, SPACE /1H.,44/
C
C  END OF INFORMATION IS DENOTED BY A . IN COLUMN 1
C  MOST VERSIONS OF FORTRAN ALLOW THIS RESTRICTION TO BE LIFTED
C  BY THE USE OF AN EXTENDED READ STATEMENT OF THE FORM
C
C              10   READ(NIN,99999,END=40)LINE
C
   10 READ (NIN,99999) LINE
      IF (LINE(1).EQ.IDOT) GO TO 40
      WRITE (NOUT,99998) LINE
C  UP STATEMENT COUNTER
      NLINE = 0
      ERR = .FALSE.
      NUMST = NUMST + 1
C  CODE LINE - KEEP LAST NON-BLANK POSITION IN NLINE
C  NOTE NON-STANDARD CHARACTERS ARE TREATED AS BLANKS
      DO 20 I=1,MAXLIN
        LINE(I) = CODECH(LINE(I),ERR)
        IF (LINE(I).NE.SPACE) NLINE = I
C  TEST NON-STANDARD CHARACTER
        IF (.NOT.ERR) GO TO 20
        K3 = I
        CALL ERROR(41HSTATEMENT CONTAINS NON-STANDARD CHARACTER,
     *   41)
        ERR = .FALSE.
   20 CONTINUE
      MXLIN1 = MAXLIN + 1
      DO 30 I=MXLIN1,LLINE
        IF (CODECH(LINE(I),ERR).EQ.SPACE) GO TO 30
        CALL
     *   ERROR(44HNON-BLANK CHARACTERS OCCUR AFTER POSITION 72,
     *   44)
        GO TO 50
   30 CONTINUE
C  TEST FOR BLANK LINE
      IF (NLINE.NE.0) GO TO 50
      CALL ERROR(39HBLANK LINE ENCOUNTERED IN INPUT-IGNORED, 39)
      GO TO 10
C  SET ENDIN FLAG
   40 ENDIN = .TRUE.
   50 RETURN
99999 FORMAT (80A1)
99998 FORMAT (1H , 80A1)
      END
C***
C                    SUBROUTINE INTEG
C***
      SUBROUTINE INTEG(ERR)
C
C  LINE(K3) CONTAINS A DIGIT
C  INTEG SCANS A LINE UNTIL A NON-DIGIT IS FOUND
C
C  ON EXIT
C     ERR = .TRUE. IF SPACES OCCUR WITHIN THE DIGIT STRING
C         = .FALSE. OTHERWISE
C
C  K3 AND JCODE ARE THE POSITION AND CODE RESPECTIVELY
C     OF THE NEXT NON-BLANK CHARACTER
C
C..ARGUMENTS
      LOGICAL ERR
C..LOCAL VARIABLES
      INTEGER K1
      LOGICAL SPACE
C..FUNCTIONS
      INTEGER CODE
      LOGICAL EATSP
C..COMMON BLOCKS
      INTEGER LLINE, NLINE, MAXLIN, LINE
      INTEGER K3, JCODE
      INTEGER NTOK, LTOK, TOKEN
      COMMON /CLINE/ LLINE, NLINE, MAXLIN, LINE(80)
      COMMON /CNXTCH/ K3, JCODE
      COMMON /CTOKEN/ LTOK, NTOK, TOKEN(72)
C  INITIALIZE
      ERR = .FALSE.
      SPACE = .FALSE.
      NTOK = 1
      TOKEN(NTOK) = LINE(K3)
C  LOOK FOR NEXT NON-BLANK
   10 K1 = K3 + 1
      IF (EATSP(K1,K3)) SPACE = .TRUE.
      IF (-1.EQ.K3) GO TO 30
C  IF LINE(K3) NOT A DIGIT THEN EXIT
      IF (CODE(K3).NE.1) GO TO 20
C  DIGIT FOUND
      NTOK = NTOK + 1
      TOKEN(NTOK) = LINE(K3)
      IF (SPACE) ERR = .TRUE.
      GO TO 10
   20 JCODE = CODE(K3)
   30 RETURN
      END
C***
C                    SUBROUTINE LETST
C***
      SUBROUTINE LETST
C
C  ANALYZE LET STATEMENT
C
C..LOCAL VARIABLES
      INTEGER EQUALS, I, K1, K2, LPAREN
      LOGICAL STRING
C..COMMON BLOCKS
      INTEGER ARPOS, ARSTAK, DLPREQ, LARST, LPOPEN, NEXT1
      INTEGER NUMST, NUMERR, LABENO
      LOGICAL ENDERR, LABERR
      LOGICAL ERR, SIMPST
      INTEGER TCODE, TYPE, VCODE, ENDEXP
      INTEGER LLINE, NLINE, MAXLIN, LINE
      INTEGER K3, JCODE
      INTEGER NREF, REF
      INTEGER NTOK, LTOK, TOKEN
      INTEGER LVAR, IVAR
      COMMON /CARFUN/ LARST, ARSTAK(40,3), NEXT1, LPOPEN,
     * DLPREQ, ARPOS
      COMMON /CERROR/ NUMST, NUMERR, ENDERR, LABENO, LABERR
      COMMON /CEXPR/ TCODE, TYPE, ERR, VCODE, ENDEXP, SIMPST
      COMMON /CLINE/ LLINE, NLINE, MAXLIN, LINE(80)
      COMMON /CNXTCH/ K3, JCODE
      COMMON /CREFER/ NREF, REF(40)
      COMMON /CTOKEN/ LTOK, NTOK, TOKEN(72)
      COMMON /CVAR/ LVAR, IVAR(376,2)
      DATA LPAREN, EQUALS /41,39/
C  GET L.H.S
      ENDEXP = NLINE
      CALL NEXTOK
      STRING = .FALSE.
      NREF = 0
C  TEST IF LEGAL L.H.S
      IF (TCODE.NE.2 .OR. TYPE.GT.3 .OR. TYPE.LT.0) CALL
     * ERROR(38HNON-ANSI L.H.S IN ASSIGNMENT STATEMENT, 38)
      IF (TCODE.EQ.2 .AND. TYPE.LE.3) GO TO 10
      K3 = K3 - 1
      GO TO 50
C  ADD TO REFERENCE CHAIN
   10 IF (VCODE.NE.0) CALL REFCHK
      IF (IABS(TYPE).NE.2) GO TO 20
      IF (TYPE.EQ.2) STRING = .TRUE.
C  IF STRING ARRAY ANALYZE SUBSCRIPTS
      IF (TOKEN(NTOK).NE.LPAREN) GO TO 40
      GO TO 30
C  COME HERE IF NUMERICAL ARRAY
   20 IF (IABS(TYPE).NE.3) GO TO 40
   30 K1 = K3
      K2 = NLINE
      NEXT1 = 1
      LPOPEN = 1
      CALL ARWIND(.FALSE.)
      CALL EXPRES(K1, K2, 1, .FALSE.)
C  TEST IF END OF LINE
      IF (-1.EQ.K3) GO TO 70
C  FINISHED L.H.S = SHOULD BE NEXT CHARACTER
   40 IF (LINE(K3).EQ.EQUALS) GO TO 60
C  NO - SCAN FOR EQUALS IN THE HOPE OF RECOVERING
      CALL ERROR(36HDELIMITER = NOT FOUND WHERE EXPECTED, 36)
   50 K3 = K3 + 1
      IF (K3.GT.NLINE) GO TO 80
      IF (LINE(K3).NE.EQUALS) GO TO 50
      CALL ERROR(22HCHECKING RESTARTS AT =, 22)
C  CHECK EXPRESSION ON R.H.S
   60 K1 = K3 + 1
      K2 = NLINE
      CALL EXPRES(K1, K2, -1, .TRUE.)
C  ILLEGAL USE OF STRING VARIABLE
      IF ((STRING .AND. (.NOT.SIMPST)) .OR. (.NOT.STRING .AND.
     * SIMPST)) CALL ERROR(22HILLEGAL USE OF STRINGS, 22)
      GO TO 90
C  ERROR EXITS
C  2) DELIMITER MISSING
   70 CALL
     * ERROR(47HDELIMITER = MISSING - REST OF STATEMENT IGNORED,
     * 47)
      GO TO 90
C  3) UNRECOVERABLE
   80 CALL ERROR(41HUNRECOVERABLE - REST OF STATEMENT IGNORED,
     * 41)
C  ADD REFERENCES TO CHAIN
   90 IF (NREF.EQ.0) GO TO 110
      DO 100 I=1,NREF
        CALL ADDREF(IVAR, LVAR, LABENO, REF(I))
  100 CONTINUE
  110 RETURN
      END
C***
C                    INTEGER FUNCTION LTOINT
C***
      INTEGER FUNCTION LTOINT(K)
C
C  FUNCTION RETURNS VIA ITS NAME AND ARGUMENT K
C  THE INTEGER VALUE OF THE LABEL STORED IN TOKEN(1-NTOK)
C
C..ARGUMENTS
      INTEGER K
C..LOCAL VARIABLES
      INTEGER I
C..COMMON BLOCKS
      INTEGER NTOK, LTOK, TOKEN
      COMMON /CTOKEN/ LTOK, NTOK, TOKEN(72)
C  INITIALIZE K
      K = TOKEN(1)
      IF (NTOK.EQ.1) GO TO 20
      DO 10 I=2,NTOK
        K = 10*K + TOKEN(I)
   10 CONTINUE
   20 LTOINT = K
      RETURN
      END
C***
C                    SUBROUTINE NEXT
C***
      SUBROUTINE NEXT
C
C  ANALYZE NEXT STATEMENT
C
C..LOCAL VARIABLES
      INTEGER I, J, K
C..COMMON BLOCKS
      INTEGER LDO, DOPEN, DOSPEC
      INTEGER NUMST, NUMERR, LABENO
      LOGICAL ENDERR, LABERR
      LOGICAL ERR, SIMPST
      INTEGER TCODE, TYPE, VCODE, ENDEXP
      LOGICAL ABNFOR
      INTEGER LFOR, NFOR, FORNXT, LJUMP, NJUMP, JUMPS
      INTEGER LLINE, NLINE, MAXLIN, LINE
      INTEGER K3, JCODE
      INTEGER LVAR, IVAR
      COMMON /CDO/ LDO, DOPEN, DOSPEC(30)
      COMMON /CERROR/ NUMST, NUMERR, ENDERR, LABENO, LABERR
      COMMON /CEXPR/ TCODE, TYPE, ERR, VCODE, ENDEXP, SIMPST
      COMMON /CFOR1/ LFOR, NFOR, FORNXT(50,2), LJUMP, NJUMP,
     * JUMPS(500,2), ABNFOR
      COMMON /CLINE/ LLINE, NLINE, MAXLIN, LINE(80)
      COMMON /CNXTCH/ K3, JCODE
      COMMON /CVAR/ LVAR, IVAR(376,2)
C  CHECK THAT AT LEAST ONE FOR LOOP IS OPEN
      IF (DOPEN.EQ.0) GO TO 60
C  GET NEXT TOKEN - SEARCH SHOULD BE COMPLETED AT END OF LINE
      ENDEXP = NLINE
      CALL NEXTOK
C  CHECK CORRECT TYPE - SIMPLE VARIABLE
      IF (TYPE.NE.1 .OR. TCODE.NE.2) GO TO 50
C  O.K. ADD VARIABLE REFERENCE TO CHAIN
      CALL ADDREF(IVAR, LVAR, LABENO, VCODE)
C  OUTPUT SPACES ERROR
      IF (ERR) CALL ERROR(37HSPACES NOT PERMITTED IN VARIABLE NAME, 37)
C  CHECK AT END OF LINE
      IF (K3.NE.ENDEXP+1) CALL
     * ERROR(32HEXTRANEOUS END TO NEXT STATEMENT, 32)
C  CHECK VARIABLE CLOSES LAST OPENED FOR LOOP
      IF (VCODE.NE.DOSPEC(DOPEN)) GO TO 20
      DOPEN = DOPEN - 1
C  BACKTRACK UP COLUMN 2 OF ARRAY FORNXT LOOKING FOR FIRST ZERO
      K = NFOR + 1
   10 K = K - 1
      IF (FORNXT(K,2).NE.0) GO TO 10
      FORNXT(K,2) = LABENO
      GO TO 70
C  NO MATCH  LOOK FOR MATCH FURTHER DOWN THE ARRAY
   20 CALL ERROR(38HFOR-NEXT STATEMENTS INCORRECTLY NESTED, 38)
      ABNFOR = .TRUE.
      IF (DOPEN.LT.2) GO TO 70
      DO 30 I=2,DOPEN
        J = DOPEN + 1 - I
        IF (DOSPEC(J).EQ.VCODE) GO TO 40
   30 CONTINUE
C  NO MATCH  RETURN
      GO TO 70
C  MATCH FOUND UNWIND DOSPEC TO THAT POINT
   40 DOPEN = J
      GO TO 70
C  ERROR EXITS
C  1)NOT A SIMPLE VARIABLE
   50 CALL
     * ERROR(
     * 56HONLY SIMPLE NUMERIC VARIABLE MAY OCCUR IN NEXT STATEMENT, 56)
      ABNFOR = .TRUE.
      GO TO 70
C  2)NO FOR LOOPS OPEN
   60 CALL ERROR(26HNEXT FOUND BUT NO FOR OPEN, 26)
      ABNFOR = .TRUE.
   70 RETURN
      END
C***
C                    SUBROUTINE NEXTOK
C***
      SUBROUTINE NEXTOK
C
C  ROUTINE NEXTOK GETS THE NEXT TOKEN, CLASIFIES IT AND PLACES
C  IT IN TOKEN
C
C  TCODE= 1(NUMBER), 2(ALPHANUMERIC), 3(NON-ALPHANUMERIC)
C  TYPE
C      NUMBER  1(INTEGER), 2(REAL), -1(ERROR)
C  ALPHANUMERIC  1(SIMPLE VARIABLE), 2(STRING), 3(SUBSCRIPTED NUMERIC)
C                4(USER DEFINED FUNCTION), 5(STANDARD FUNCTION)
C               -1(ILLEGAL SIMPLE VARIABLE)
C               -2(ILLEGAL STRING VAR/ARRAY/FUNCTION)
C               -3(ILLEGAL FUNCTION/ARRAY)
C
C
C..LOCAL VARIABLES
      INTEGER DOLLAR, K2, LPAREN, PERIOD, SPACE
      LOGICAL LTEMP
C..FUNCTIONS
      INTEGER CODE, CODVAR
      LOGICAL EATSP
C..COMMON BLOCKS
      LOGICAL ERR, SIMPST
      INTEGER TCODE, TYPE, VCODE, ENDEXP
      INTEGER LLINE, NLINE, MAXLIN, LINE
      INTEGER K3, JCODE
      INTEGER NTOK, LTOK, TOKEN
      COMMON /CEXPR/ TCODE, TYPE, ERR, VCODE, ENDEXP, SIMPST
      COMMON /CLINE/ LLINE, NLINE, MAXLIN, LINE(80)
      COMMON /CNXTCH/ K3, JCODE
      COMMON /CTOKEN/ LTOK, NTOK, TOKEN(72)
      DATA SPACE, PERIOD, DOLLAR, LPAREN /44,40,51,41/
C  IT IS ASSUMED NEXT NON-BLANK IS IN K3  CODE = JCODE
C  INITIALIZATION
      NTOK = 1
      VCODE = 0
      TOKEN(NTOK) = LINE(K3)
      ERR = .FALSE.
C  JCODE = 3
      IF (JCODE.NE.3) GO TO 10
C  IF A PERIOD THEN PICK UP NUMBER
      IF (LINE(K3).EQ.PERIOD) GO TO 20
C  RESET K3 AND JCODE
      TCODE = 3
      GO TO 210
C  NEXT TOKEN A NUMBER
   10 IF (JCODE.NE.1) GO TO 30
   20 CALL NUMBER(TYPE, ERR)
      TCODE = 1
      GO TO 220
C  ALPHABETIC CHARACTER
   30 LTEMP = .FALSE.
      TCODE = 2
C  PICK UP ALPHANUMERIC STRING
   40 K3 = K3 + 1
      IF (K3.GT.ENDEXP) GO TO 100
C  IGNORE SPACES
      IF (LINE(K3).NE.SPACE) GO TO 50
      LTEMP = .TRUE.
      GO TO 40
C  EXIT FROM ALPHA STRING IF CODE=3
   50 IF (CODE(K3).EQ.3) GO TO 60
C  ELSE ADD INTO TOKEN AND SET ERR IF SPACES
      IF (LTEMP) ERR = .TRUE.
      NTOK = NTOK + 1
      TOKEN(NTOK) = LINE(K3)
      GO TO 40
C  EXIT HERE WHEN ALPHA STRING FINISHED
C  TEST IF DOLLAR FOLLOWS - STRING
   60 IF (LINE(K3).NE.DOLLAR) GO TO 90
C  IF SPACES BETWEEN CHARACTER AND DOLLAR THEN ERROR
      IF (LTEMP) ERR = .TRUE.
      NTOK = NTOK + 1
      TOKEN(NTOK) = DOLLAR
C  GET NEXT NON-BLANK
   70 K3 = K3 + 1
      IF (K3.GT.ENDEXP) GO TO 80
C  CAN IGNORE SPACES HERE
      IF (LINE(K3).EQ.SPACE) GO TO 70
C  TEST IF OPENING BRACKET
      IF (LINE(K3).NE.LPAREN) GO TO 80
C  YES - ILLEGAL STRING ARRAY OR FUNCTION
      NTOK = NTOK + 1
      TOKEN(NTOK) = LPAREN
      GO TO 150
C  IF NOT CHECK LENGTH FOR LEGAL STRING
C  ADJUST K3 FOR EXIT
   80 K3 = K3 - 1
C  IF NTOK.GT.2 THEN ILLEGAL STRING
      IF (NTOK-2) 170, 170, 150
C  NO DOLLAR LOOK FOR AN OPENING BRACKET
   90 IF (LINE(K3).EQ.LPAREN) GO TO 120
C  LOOK FOR SIMPLE VARIABLE - ADJUST K3 HERE
  100 K3 = K3 - 1
C  SIMPLE VARIABLE (LENGTH.LE.2)
C  FUNCTION CHECK (LENGTH.EQ.3)
C  ILLEGAL VARIABLE (LENGTH.GT.3) COULD BE AN ILLEGAL FUNCTION
C                                 WITH NO ARGUMENT
      IF (NTOK-3) 110, 130, 140
C  TEST SIMPLE VARIABLE
  110 VCODE = CODVAR(1)
C  VCODE=0  TYPE=-1  ILLEGAL VARIABLE
      IF (VCODE.EQ.0) GO TO 140
C  OTHERWISE OUT
      TYPE = 1
      GO TO 210
C  OPENING BRACKET - ADD INTO TOKEN
  120 NTOK = NTOK + 1
      TOKEN(NTOK) = LPAREN
C  NUMERICAL ARRAY
      IF (NTOK.EQ.2) GO TO 180
C  ILLEGAL FUNCTION OR ARRAY
      IF (NTOK.NE.4) GO TO 160
C  CHECK IF USER DEFINED OR STANDARD FUNCTION
  130 VCODE = CODVAR(5)
C  STANDARD FUNCTION EXIT
      IF (VCODE.NE.0) GO TO 200
C  TRY USER DEFINED
      VCODE = CODVAR(4)
C  EXIT EITHER WITH CODE OR ILLEGAL
      IF (VCODE) 160, 160, 190
C  ILLEGAL NUMERICAL VARIABLE
  140 TYPE = -1
      GO TO 210
C  ILLEGAL STRING
  150 TYPE = -2
      GO TO 210
C  ILLEGAL ARRAY/FUNCTION  NUMERICAL
  160 TYPE = -3
      GO TO 210
C  LEGAL STRING
  170 TYPE = 2
      VCODE = CODVAR(2)
      GO TO 210
C  LEGAL ARRAY
  180 TYPE = 3
      VCODE = CODVAR(3)
      GO TO 210
C  USER FUNCTION
  190 TYPE = 4
      GO TO 210
C  STANDARD FUNCTION
  200 TYPE = 5
  210 K2 = K3 + 1
      LTEMP = EATSP(K2,K3)
  220 IF (-1.NE.K3) GO TO 230
      K3 = ENDEXP + 1
      GO TO 240
  230 JCODE = CODE(K3)
  240 RETURN
      END
C***
C                    SUBROUTINE NUMBER
C***
      SUBROUTINE NUMBER(TYPE, ERR)
C
C  START WITH LINE(K3) EITHER A PERIOD OR A DIGIT
C  AND SCAN LINE UNTIL A COMPLETE NUMERICAL CONSTANT
C  HAS BEEN FOUND
C
C  RETURN K3 AND JCODE AS POSITION AND CODE OF NEXT
C  NON-BLANK CHARACTER
C
C  ERR = .FALSE. IF NO BLANKS IN CONSTANT
C      = .TRUE.  IF BLANKS PRESENT
C
C  TYPE = 1  FOR INTEGER
C       = 2  FOR REAL
C       = -1 FOR ERROR
C
C..ARGUMENTS
      INTEGER TYPE
      LOGICAL ERR
C..LOCAL VARIABLES
      INTEGER E, K, K1, MAXEXP, MINUS, PERIOD, PLUS
      LOGICAL LSPACE
C..FUNCTIONS
      INTEGER CODE, LTOINT
      LOGICAL EATSP
C..COMMON BLOCKS
      INTEGER LLINE, NLINE, MAXLIN, LINE
      INTEGER K3, JCODE
      COMMON /CLINE/ LLINE, NLINE, MAXLIN, LINE(80)
      COMMON /CNXTCH/ K3, JCODE
      DATA PERIOD, E, PLUS, MINUS, MAXEXP /40,14,36,37,38/
      LSPACE = .FALSE.
      ERR = .FALSE.
      TYPE = 1
C  TEST IF PERIOD
      IF (LINE(K3).NE.PERIOD) GO TO 10
C  NEXT CHARACTER MUST BE A DIGIT ELSE ERROR
      TYPE = 2
      K1 = K3 + 1
      IF (EATSP(K1,K3)) LSPACE = .TRUE.
      IF (-1.EQ.K3) GO TO 40
      IF (CODE(K3).NE.1) GO TO 40
C  EAT DIGITS
   10 IF (LSPACE) ERR = .TRUE.
      CALL INTEG(LSPACE)
      IF (LSPACE) ERR = .TRUE.
C  END OF LINE RETURN EITHER INTEGER OR .INTEGER
      IF (-1.EQ.K3) GO TO 50
C  TEST FOR PERIOD (40)
      IF (LINE(K3).NE.PERIOD) GO TO 20
C  IF TYPE=2 THEN ERROR - TWO DECIMAL POINTS IN NUMBER
      IF (TYPE.EQ.2) GO TO 40
C  NOT AN INTEGER
      TYPE = 2
      K1 = K3 + 1
C  LOOK FOR A DIGIT
      IF (EATSP(K1,K3)) LSPACE = .TRUE.
      IF (-1.EQ.K3) GO TO 50
C  MAYBE AN EXPONENT
      IF (CODE(K3).NE.1) GO TO 20
C  FRACTIONAL PART - EAT IT AND ANY OTHERS
      IF (LSPACE) ERR = .TRUE.
      CALL INTEG(LSPACE)
      IF (LSPACE) ERR = .TRUE.
      IF (-1.EQ.K3) GO TO 50
C  IS EXPONENT PRESENT - IF NOT EXIT
   20 IF (LINE(K3).NE.E) GO TO 50
C  E FOUND
      TYPE = 2
      K1 = K3 + 1
      IF (EATSP(K1,K3)) LSPACE = .TRUE.
C  ERROR IF END OF LINE HERE
      IF (-1.EQ.K3) GO TO 40
C  TEST FOR + OR - SIGN
      IF (LINE(K3).NE.PLUS .AND. LINE(K3).NE.MINUS) GO TO 30
C  EAT SIGN IF PRESENT
      K1 = K3 + 1
      IF (EATSP(K1,K3)) LSPACE = .TRUE.
      IF (-1.EQ.K3) GO TO 40
C  LOOK FOR INTEGER EXPONENT
   30 JCODE = CODE(K3)
C  ERROR IF NOT INTEGER
      IF (JCODE.NE.1) GO TO 40
C  EAT EXPONENT
      IF (LSPACE) ERR = .TRUE.
      CALL INTEG(LSPACE)
      IF (LTOINT(K).GT.MAXEXP) CALL
     * ERROR(
     * 50HWARNING EXPONENT VALUE EXCEEDS MINIMAL REQUIREMENT,
     * 50)
      IF (LSPACE) ERR = .TRUE.
      GO TO 50
   40 TYPE = -1
      IF (-1.NE.K3) JCODE = CODE(K3)
   50 RETURN
      END
C***
C                    SUBROUTINE OCHAIN
C***
      SUBROUTINE OCHAIN(IST, IEND, ICODE)
C..ARGUMENTS
      INTEGER ICODE, IEND, IST
C..LOCAL VARIABLES
      INTEGER L
      INTEGER CH(3), TEMP(6)
      INTEGER J, K
      LOGICAL FIRST, ENDCH
C..COMMON BLOCKS
      INTEGER LCHAIN, NCHAIN, CHAIN
      INTEGER NIN, NOUT, NTAB
      LOGICAL ENDIN
      COMMON /CCHAIN/ LCHAIN, NCHAIN, CHAIN(5000)
      COMMON /CIO/ NIN, NOUT, NTAB, ENDIN
      FIRST = .TRUE.
      ENDCH = .FALSE.
   10 DO 30 J=1,6
        K = J
        TEMP(K) = CHAIN(IST)
        IF (IST.NE.IEND) GO TO 20
        ENDCH = .TRUE.
        GO TO 40
C  PICK UP NEXT REFERENCE
   20   IST = CHAIN(IST+1)
   30 CONTINUE
   40 IF (.NOT.FIRST) GO TO 50
      FIRST = .FALSE.
      CALL DCODE(CH, ICODE)
      WRITE (NTAB,99999) (CH(L),L=1,3), (TEMP(L),L=1,K)
      GO TO 60
   50 WRITE (NTAB,99998) (TEMP(L),L=1,K)
C  CHECK IF END OF CHAIN
   60 IF (.NOT.ENDCH) GO TO 10
      RETURN
99999 FORMAT (4X, 3A1, 8X, 1H-, 4X, 6I8)
99998 FORMAT (20X, 6I8)
      END
C***
C                    SUBROUTINE ONSTAT
C***
      SUBROUTINE ONSTAT
C
C  ROUTINE CHECKS ON - GOTO STATEMENT
C
C..LOCAL VARIABLES
      INTEGER GOKEY(5)
      INTEGER COMMA, I, IREF, JREF, K, K1, K2, K4, SPACE
      LOGICAL ERR, LSPACE, LTEMP
C..FUNCTIONS
      INTEGER CODE, LTOINT
      LOGICAL CHKKEY, EATSP
C..COMMON BLOCKS
      INTEGER NUMST, NUMERR, LABENO
      LOGICAL ENDERR, LABERR
      INTEGER LLINE, NLINE, MAXLIN, LINE
      INTEGER K3, JCODE
      INTEGER NREF, REF
      INTEGER LVAR, IVAR
      COMMON /CERROR/ NUMST, NUMERR, ENDERR, LABENO, LABERR
      COMMON /CLINE/ LLINE, NLINE, MAXLIN, LINE(80)
      COMMON /CNXTCH/ K3, JCODE
      COMMON /CREFER/ NREF, REF(40)
      COMMON /CVAR/ LVAR, IVAR(376,2)
      DATA GOKEY(1), GOKEY(2), GOKEY(3), GOKEY(4), GOKEY(5)
     * /16,24,29,24,2/
      DATA SPACE, COMMA /44,59/
C  INITIALIZE
      LSPACE = .FALSE.
      ERR = .FALSE.
      NREF = 0
      IREF = 0
C  K3 HOLDS NEXT NON-BLANK
      K1 = K3
C  LOOK FOR GOTO - NOTE CAN HAVE SPACES BETWEEN GO AND TO
      IF (.NOT.(CHKKEY(GOKEY,GOKEY(5),K1,K2))) GO TO 80
C  FOUND IT - CHECK PRECEDED BY SPACE
      IF (LINE(K1-1).NE.SPACE) ERR = .TRUE.
C  CHECK LENGTH = 2
      IF (K2-K1.NE.1) LSPACE = .TRUE.
C  EAT ANY SPACES BETWEEN GO AND TO
      K2 = K2 + 1
      LTEMP = EATSP(K2,K4)
C  IF END OF LINE KEYWORD IS MISING
      IF (-1.EQ.K4) GO TO 80
C  CHECK TO IS THERE
      IF (.NOT.(CHKKEY(GOKEY(3),GOKEY(5),K4,K2))) GO TO 80
C  IF END OF LINE - NO STATEMENT LABELS
      IF (K2.EQ.NLINE) GO TO 90
C  YES - CHECK SPACE AFTER
      IF (LINE(K2+1).NE.SPACE) ERR = .TRUE.
C  AND DOES NOT CONTAIN SPACES
      IF (K2-K4.NE.1) LSPACE = .TRUE.
C  CHECK EXPRESSION BETWEEN K3 AND K1-1
      K4 = K3
      CALL EXPRES(K4, K1-1, -1, .FALSE.)
C  ADD REFERENCES TO VARIABLES IN CHAIN
      IF (NREF.GT.0) GO TO 10
      CALL
     * ERROR(46HWARNING - NO VARIABLE CONTROLLING ON STATEMENT,
     * 46)
      GO TO 30
   10 DO 20 I=1,NREF
        CALL ADDREF(IVAR, LVAR, LABENO, REF(I))
   20 CONTINUE
C  REZERO NREF TO HOLD STATEMENT NUMBERS
      NREF = 0
C  NOW OUTPUT ANY ERRORS CONCERNING KEYWORDS
   30 IF (ERR) CALL
     * ERROR(38HSPACES MUST PRECEDE AND FOLLOW KEYWORD, 38)
      IF (LSPACE) CALL
     * ERROR(33HSPACES NOT ALLOWED WITHIN KEYWORD, 33)
C  COLLECT STATEMENT NUMBERS
      K2 = K2 + 1
   40 LTEMP = EATSP(K2,K3)
C  ERROR IF END OF LINE HERE EITHER LINE ENDS IN COMMA OR
C  NO REFERENCES
      IF (-1.EQ.K3) GO TO 90
C  NEXT NON-BLANK MUST BE NUMERIC
      IF (CODE(K3).NE.1) GO TO 100
C  EAT INTEGER
      CALL INTEG(ERR)
      IF (ERR) CALL
     * ERROR(38HSPACES NOT ALLOWED IN STATEMENT NUMBER, 38)
C  TRANSLATE REFERENCE INTO DECIMAL FORM
      JREF = LTOINT(K)
C  CHECK TO SEE IF REFERENCE ALREADY EXISTS
C  NO REFERENCES YET
      IF (NREF.EQ.0) GO TO 60
C  CHECK PRESENT LIST
      DO 50 I=1,NREF
        IF (REF(I).EQ.JREF) GO TO 70
   50 CONTINUE
C  ADD TO END OF LIST
   60 NREF = NREF + 1
      REF(NREF) = JREF
C  CHECK FOR END OF LINE OR A COMMA
C  NOTE END OF LINE WOULD HAVE BEEN SET BY INTEG
C  THIS IS THE CLEAN EXIT
   70 IF (-1.EQ.K3) GO TO 120
C  TEST FOR COMMA
      IF (LINE(K3).NE.COMMA) GO TO 110
C  GET NEXT STATEMENT NUMBER
      K2 = K3 + 1
      GO TO 40
C  ERROR EXITS
C  KEY WORD MISSING OR WRONG
   80 CALL ERROR(31HKEYWORD MISSING OR NON-STANDARD, 31)
      GO TO 140
C  STATEMENT NUMBER MISSING
   90 IF (IREF.GT.0) GO TO 100
      CALL ERROR(34HNO STATEMENT NUMBER FOLLOWING GOTO, 34)
      GO TO 140
C  END WITH A COMMA
  100 CALL ERROR(31HSTATEMENT NUMBER MUST FOLLOW , , 31)
      GO TO 120
C  NO COMMA WHERE ONE EXPECTED
  110 CALL ERROR(42HILLEGAL DELIMITER IN STATEMENT NUMBER LIST,
     * 42)
C  ADD REFERENCES TO CHAIN
  120 DO 130 I=1,NREF
        CALL ADDSTA(REF(I))
        CALL CHKREF(LABENO, REF(I))
  130 CONTINUE
  140 RETURN
      END
C***
C                    SUBROUTINE OPTSMT
C***
      SUBROUTINE OPTSMT
C
C  CHECKS THE OPTION BASE STATEMENT
C  ON ENTRY K3 AND JCODE POINT TO THE NEXT NON-BLANK CHARACTER
C
C..LOCAL VARIABLES
      INTEGER BASE(5)
      INTEGER AEND, ASTART, I, K1, K2, ONE, SPACE, ZERO
      LOGICAL ERR
C..FUNCTION
      LOGICAL EATSP, CHKKEY
C..COMMON BLOCKS
      INTEGER LLINE, NLINE, MAXLIN, LINE
      INTEGER K3, JCODE
      LOGICAL DIMYET, OPTYET
      INTEGER OPTSET
      INTEGER LVAR, IVAR
      COMMON /CLINE/ LLINE, NLINE, MAXLIN, LINE(80)
      COMMON /CNXTCH/ K3, JCODE
      COMMON /COPT/ DIMYET, OPTYET, OPTSET
      COMMON /CVAR/ LVAR, IVAR(376,2)
      DATA SPACE, ZERO, ONE, ASTART, AEND /44,0,1,313,338/
      DATA BASE(1), BASE(2), BASE(3), BASE(4), BASE(5)
     * /11,10,28,14,4/
C  IF JCODE .NE. 2 (LETTER) THEN KEYWORD IS NON-ANSI
      IF (JCODE.NE.2) GO TO 70
C  CHECK BASE KEYWORD PRESENT
      K1 = K3
      IF (.NOT.(CHKKEY(BASE,BASE(5),K1,K2))) GO TO 70
C  OUTPUT ERROR FOR ENCLOSED BLANKS
      K3 = K2
      IF (K3+1-K1.NE.BASE(5)) CALL ERROR(17HSPACES IN KEYWORD,
     * 17)
C  NO PARAMETER FOLLOWS
      IF (K2.EQ.NLINE) GO TO 30
      K3 = K3 + 1
      IF (LINE(K3).EQ.SPACE) GO TO 10
      CALL ERROR(24HNO SPACE FOLLOWS KEYWORD, 24)
      GO TO 20
C  EAT SPACES UP TO NEXT NON-BLANK
   10 K1 = K3 + 1
      ERR = EATSP(K1,K3)
      IF (-1.EQ.K3) GO TO 30
C  TEST FOR CORRECT PARAMETER
   20 IF (LINE(K3).EQ.ZERO .OR. LINE(K3).EQ.ONE) GO TO 40
   30 CALL ERROR(41HILLEGAL OR MISSING PARAMETER IN STATEMENT,
     * 41)
      GO TO 80
C  TEST AT END OF STATEMENT
   40 IF (K3.NE.NLINE) GO TO 60
C  HAVE A LEGAL OPTIONBASE STATEMENT - DO TESTS
C  1)  TEST IF THERE HAS BEEN A DIM STATEMENT PRIOR TO OPTION
      IF (DIMYET) CALL ERROR(28HOPTION STATEMENT FOLLOWS DIM,
     * 28)
C  2)  TEST IF THERE HAS ALREADY BEEN AN OPTION STATEMENT
      IF (OPTYET) CALL
     * ERROR(32HMULTIPLE USE OF OPTION STATEMENT, 32)
      OPTSET = LINE(K3)
      OPTYET = .TRUE.
C  3)  SEE IF OPTION STATEMENT FOLLOWS ARRAY REFERENCE
C      I.E. ARE ANY ELEMENTS OF IVAR(.,I) NON-ZERO
      DO 50 I=ASTART,AEND
        IF (IVAR(I,1).EQ.0) GO TO 50
        CALL ERROR(40HOPTION STATEMENT FOLLOWS ARRAY REFERENCE,
     *   40)
        GO TO 80
   50 CONTINUE
C  NO ARRAY REFERENCES - RETURN
      GO TO 80
   60 CALL
     * ERROR(
     * 49HEXTRANEOUS INFORMATION FOLLOWING OPTION STATEMENT, 49)
      GO TO 80
   70 CALL
     * ERROR(46HNON-STANDARD KEYWORD REST OF STATEMENT IGNORED,
     * 46)
   80 RETURN
      END
C***
C                    SUBROUTINE PRINT
C***
      SUBROUTINE PRINT
C
C  ANALYZES PRINT STATEMENT
C
C..LOCAL VARIABLES
      INTEGER COMMA, I, K, K1, K2, LPAREN, OPEN, QUOTE, RPAREN,
     * SCOLON, SPACE, TABCOD
      LOGICAL ERR1
C..FUNCTIONS
      INTEGER CODE, QSTRG
C..COMMON BLOCKS
      INTEGER NUMST, NUMERR, LABENO
      LOGICAL ENDERR, LABERR
      LOGICAL ERR, SIMPST
      INTEGER TCODE, TYPE, CODVAR, VCODE, ENDEXP
      INTEGER LLINE, NLINE, MAXLIN, LINE
      INTEGER K3, JCODE
      INTEGER NREF, REF
      INTEGER NTOK, LTOK, TOKEN
      INTEGER LVAR, IVAR
      COMMON /CERROR/ NUMST, NUMERR, ENDERR, LABENO, LABERR
      COMMON /CEXPR/ TCODE, TYPE, ERR, VCODE, ENDEXP, SIMPST
      COMMON /CLINE/ LLINE, NLINE, MAXLIN, LINE(80)
      COMMON /CNXTCH/ K3, JCODE
      COMMON /CREFER/ NREF, REF(40)
      COMMON /CTOKEN/ LTOK, NTOK, TOKEN(72)
      COMMON /CVAR/ LVAR, IVAR(376,2)
      DATA QUOTE /48/
      DATA COMMA, SCOLON, LPAREN, RPAREN, SPACE /59,56,41,38,44/
      DATA TABCOD /376/
C  PRINT STATEMENT MAY OCCUR ALONE
      IF (K3+1.GT.NLINE) GO TO 120
      NREF = 0
      IF (LINE(K3+1).NE.SPACE) CALL
     * ERROR(38HSPACES MUST PRECEDE AND FOLLOW KEYWORD, 38)
C  OTHERWISE EAT ALL SPACES, COMMAS AND SEMI-COLONS
   10 K3 = K3 + 1
      IF (K3.GT.NLINE) GO TO 100
      IF (LINE(K3).EQ.SPACE .OR. LINE(K3).EQ.COMMA .OR.
     * LINE(K3).EQ.SCOLON) GO TO 10
C  TEST FOR QUOTED STRING
      IF (LINE(K3).NE.QUOTE) GO TO 20
      I = QSTRG(K)
      IF (-1.EQ.K .OR. (-1.EQ.K3)) GO TO 100
C  NEXT MUST BE A PRINT DELIMITER - ELSE ERROR
      IF (LINE(K3).EQ.COMMA .OR. LINE(K3).EQ.SCOLON) GO TO 10
      CALL ERROR(40HPRINT DELIMITER NOT FOUND WHERE EXPECTED,
     * 40)
      CALL ERROR(25HREST OF STATEMENT IGNORED, 25)
C  TEST FOR TAB FUNCTION
   20 K1 = K3
      JCODE = CODE(K3)
      IF (JCODE.NE.2) GO TO 30
      ENDEXP = NLINE
      CALL NEXTOK
      IF (CODVAR(6).NE.TABCOD) GO TO 30
      VCODE = TABCOD
      IF (ERR) CALL
     * ERROR(37HSPACES NOT PERMITTED IN FUNCTION NAME, 37)
C  SCAN TO MATCHING CLOSING BRACKETS  TAB ARGUMENT = EXPRESSION
      CALL REFCHK
      K1 = NLINE
      K2 = K3
      CALL EXPRES(K2, K1, 1, .FALSE.)
C  NOTE NOW K3 HOLDS NEXT NON-BLANK POSITION OR -1
C  TAB MUST BE FOLLOWED BY COMMA, SEMI-COLON OR END OF LINE
      IF (-1.EQ.K3) GO TO 100
      IF (LINE(K3).EQ.COMMA .OR. LINE(K3).EQ.SCOLON) GO TO 10
      K2 = K3 - 1
      CALL
     * ERROR(44HTAB FUNCTION MUST BE FOLLOWED BY A DELIMITER,
     * 44)
      CALL ERROR(29HFLUSH TO NEXT PRINT DELIMITER, 29)
      ERR1 = .TRUE.
      GO TO 40
C  LOOK FOR NEXT DELIMITER AND ANALYZE CONTAINED EXPRESSION (NOT TAB)
   30 K2 = K1 - 1
      ERR1 = .FALSE.
   40 OPEN = 0
C  WANT NEXT COMMA OR SCOLON NOT IN PARENTHESES
   50 K2 = K2 + 1
      IF (OPEN.NE.0) GO TO 60
      IF (K2.GT.NLINE) GO TO 70
      IF (LINE(K2).EQ.COMMA .OR. LINE(K2).EQ.SCOLON) GO TO 70
C  NOT FOUND - TEST IF OPENING OR CLOSING BRACKET
   60 IF (K2.GT.NLINE) GO TO 90
      IF (LINE(K2).EQ.LPAREN) OPEN = OPEN + 1
      IF (LINE(K2).EQ.RPAREN) OPEN = OPEN - 1
      GO TO 50
C  FOUND - ANALYZE EXPRESSION IF ERR1 = .FALSE. ELSE SKIP
   70 IF (ERR1) GO TO 80
      CALL EXPRES(K1, K2-1, -1, .FALSE.)
   80 K3 = K2
C  EXIT IF AT END OF LINE
      IF (K2.GT.NLINE) GO TO 100
      GO TO 10
C  ERROR - MISMATCH PARENTHESES IN EXPRESSION
   90 K3 = K2
      CALL ERROR(26HSYNTAX ERROR IN EXPRESSION, 26)
      GO TO 100
C  WRITE REFERENCES TO CHAIN
  100 IF (NREF.EQ.0) GO TO 120
      DO 110 I=1,NREF
        CALL ADDREF(IVAR, LVAR, LABENO, REF(I))
  110 CONTINUE
  120 RETURN
      END
C***
C                    INTEGER FUNCTION QSTRG
C***
      INTEGER FUNCTION QSTRG(K)
C
C  K3 IS ASSUMED TO POINT AT THE OPENING QUOTE (48)
C
C  ON EXIT
C  QSTRG=K=LENGTH OF STRING     SET NEGATIVE IF ERROR OCCURS
C  K3 AND JCODE ARE THE POSITION AND CODE OF THE NEXT NON-BLANK
C  NULL STRING IS ANSI STANDARD
C
C..ARGUMENTS
      INTEGER K
C..LOCAL VARIABLES
      INTEGER K1, QUOTE
      LOGICAL LTEMP
C..FUNCTIONS
      INTEGER CODE
      LOGICAL EATSP
C..COMMON BLOCKS
      INTEGER K3, JCODE
      INTEGER LLINE, NLINE, MAXLIN, LINE
      COMMON /CNXTCH/ K3, JCODE
      COMMON /CLINE/ LLINE, NLINE, MAXLIN, LINE(80)
      DATA QUOTE /48/
      K = 0
   10 K3 = K3 + 1
      IF (K3.GT.NLINE) GO TO 20
C  CHECK FOR CLOSING QUOTE
      IF (LINE(K3).EQ.QUOTE) GO TO 30
C  OTHERWISE UPDATE LENGTH AND GET NEXT CHARACTER
      K = K + 1
      GO TO 10
C  ERROR EXIT
   20 CALL ERROR(35HNO MATCHING CLOSING QUOTE IN STRING, 35)
      K = -1
      K3 = -1
      GO TO 40
   30 K1 = K3 + 1
      LTEMP = EATSP(K1,K3)
      IF (-1.EQ.K3) GO TO 40
      JCODE = CODE(K3)
   40 QSTRG = K
      RETURN
      END
C***
C                    SUBROUTINE REFCHK
C***
      SUBROUTINE REFCHK
C
C  ROUTINE CHECKS WHETHER VCODE OCCURS IN REF(1-NREF)
C  IF NOT IT IS ADDED IN
C
C..LOCAL VARIABLES
      INTEGER I
C..COMMON BLOCKS
      LOGICAL ERR, SIMPST
      INTEGER TCODE, TYPE, VCODE, ENDEXP
      INTEGER NREF, REF
      COMMON /CEXPR/ TCODE, TYPE, ERR, VCODE, ENDEXP, SIMPST
      COMMON /CREFER/ NREF, REF(40)
      IF (NREF.EQ.0) GO TO 20
      DO 10 I=1,NREF
        IF (REF(I).EQ.VCODE) GO TO 30
   10 CONTINUE
C  REFERENCE DOES NOT OCCUR
   20 NREF = NREF + 1
      REF(NREF) = VCODE
   30 RETURN
      END
C***
C                    SUBROUTINE REM
C***
      SUBROUTINE REM
C
C  ROUTINE DEALS WITH REM STATEMENTS
C  CHECK SPACE FOLLOWS KEYWORD UNLESS REM OCCURS ALONE ON
C  THE LINE.
C  NEGATE STATNO SO REFERENCES TO REM STATEMENTS MAY BE NOTED
C
C..LOCAL VARIABLES
      INTEGER K1
C..FUNCTIONS
      LOGICAL EATSP
C..COMMON BLOCKS
      INTEGER LLINE, NLINE, MAXLIN, LINE
      INTEGER K3, JCODE
      INTEGER LSTAT, NSTAT, BNSTAT, STATNO, STAREF
      COMMON /CLINE/ LLINE, NLINE, MAXLIN, LINE(80)
      COMMON /CNXTCH/ K3, JCODE
      COMMON /CSTAT/ LSTAT, NSTAT, BNSTAT, STATNO(500),
     * STAREF(500,2)
C  NEGATE PRESENT STATEMENT REFERENCE
      STATNO(NSTAT) = -STATNO(NSTAT)
C  CHECK IF REM ONLY APPEARS ON LINE
      K1 = K3 + 1
      IF (K1.GT.NLINE) GO TO 10
C  ELSE CHECK AT LEAST ONE SPACE
      IF (.NOT.EATSP(K1,K3)) CALL
     * ERROR(24HNO SPACES FOLLOW KEYWORD, 24)
   10 RETURN
      END
C***
C                    SUBROUTINE RSTEND
C***
      SUBROUTINE RSTEND(CLASS)
C
C  ROUTINE FOR END (CODE 4), RANDOMIZE (CODE 15), RESTORE (CODE 18),
C  RETURN (CODE 19), AND STOP (CODE 20) STATEMENTS.  K3 (IN CNXTCH)
C  GIVES THE POSITION IN THE ARRAY LINE OF THE LAST CHARACTER
C  OF THE KEYWORD.  THIS SHOULD EQUAL NLINE FOR THE FOUR CASES
C  TESTED HERE.
C
C..ARGUMENTS
      INTEGER CLASS
C..COMMON BLOCKS
      INTEGER NUMST, NUMERR, LABENO
      LOGICAL ENDERR, LABERR
      INTEGER LLINE, NLINE, MAXLIN, LINE
      INTEGER K3, JCODE
      COMMON /CERROR/ NUMST, NUMERR, ENDERR, LABENO, LABERR
      COMMON /CLINE/ LLINE, NLINE, MAXLIN, LINE(80)
      COMMON /CNXTCH/ K3, JCODE
C  IF END STATEMENT SET ENDERR TRUE
      IF (CLASS.EQ.4) ENDERR = .TRUE.
C  K3 SHOULD BE EQUAL TO NLINE FOR THESE 4 CASES
      IF (K3.EQ.NLINE) GO TO 10
C  OTHERWISE OUTPUT ERROR MESSAGES FOR EXTRANEOUS END OF STATEMENT
      IF (CLASS.EQ.4) CALL
     * ERROR(46HEXTRANEOUS INFORMATION FOLLOWING END STATEMENT,
     * 46)
      IF (CLASS.EQ.15) CALL
     * ERROR(
     * 52HEXTRANEOUS INFORMATION FOLLOWING RANDOMIZE STATEMENT,
     * 52)
      IF (CLASS.EQ.18) CALL
     * ERROR(
     * 50HEXTRANEOUS INFORMATION FOLLOWING RESTORE STATEMENT,
     * 50)
      IF (CLASS.EQ.19) CALL
     * ERROR(
     * 49HEXTRANEOUS INFORMATION FOLLOWING RETURN STATEMENT, 49)
      IF (CLASS.EQ.20) CALL
     * ERROR(47HEXTRANEOUS INFORMATION FOLLOWING STOP STATEMENT,
     * 47)
   10 RETURN
      END
C**
C                    SUBROUTINE SYSERR
C**
      SUBROUTINE SYSERR(IERROR)
C
C  TERMINAL ERRORS CAUSED BY ARRAY OVERFLOWS
C  IF THESE ERRORS OCCUR THE OFFENDING ARRAY MUST BE LENGTHENED
C  IN THE CORRESPONDING COMMON BLOCK IN ALL PARTS OF THE PROGRAM
C  THE VALUE OF THE MAXIMUM LENGTH OF THIS ARRAY MUST ALSO BE
C  CHANGED IN THE MAIN PROGRAM.
C
C..ARGUMENTS
      INTEGER IERROR
C  THE FOLLOWING STATEMENT IS NECESSARY TO SURPRESS ERROR
C  MESSAGES FROM THE IBM H-EXTENDED (ENHANCED) COMPILER
C  WHICH OBJECTS TO EITHER NO RETURN STATEMENT OR AN
C  UNLABELLED RETURN FOLLOWING THE STOP.
C  N.B. THE CONDITION I=0 CANNOT OCCUR
      IF(I.EQ.0)GOTO 90
      CALL ERROR(26H******TERMINAL ERROR******, 26)
      GO TO (10, 20, 30, 40, 50, 60, 70), IERROR
   10 CALL ERROR(39HARRAY STATNO OVERFLOW IN ROUTINE ADDSTA, 39)
      GO TO 80
   20 CALL ERROR(38HARRAY CHAIN OVERFLOW IN ROUTINE ADDREF, 38)
      GO TO 80
   30 CALL ERROR(38HARRAY DOSPEC OVERFLOW IN ROUTINE FORST, 38)
      GO TO 80
   40 CALL ERROR(39HARRAY STATNO OVERFLOW IN ROUTINE CHKLAB, 39)
      GO TO 80
   50 CALL ERROR(38HARRAY JUMPS OVERFLOW IN ROUTINE UPJUMP, 38)
      GO TO 80
   60 CALL ERROR(38HARRAY FORNXT OVERFLOW IN ROUTINE FORST, 38)
      GO TO 80
   70 CALL ERROR(39HARRAY ARSTAK OVERFLOW IN ROUTINE ARWIND, 39)
   80 STOP
   90 RETURN
      END
C***
C                    SUBROUTINE TIDYUP
C***
      SUBROUTINE TIDYUP
C
C  TIDY UP LOOSE ENDS AND OUTPUT STATISTICS
C
C..LOCAL VARIABLES
      INTEGER CH(3)
      INTEGER I, IST, ISUBS, J, KEYARR, KEYSNV
      LOGICAL ONE
C..FUNCTIONS
      LOGICAL CHKFOR
C..COMMON BLOCKS
      INTEGER LDO, DOPEN, DOSPEC
      INTEGER NUMST, NUMERR, LABENO
      LOGICAL ENDERR, LABERR
      LOGICAL ABNFOR
      INTEGER LFOR, NFOR, FORNXT, LJUMP, NJUMP, JUMPS
      INTEGER NIN, NOUT, NTAB
      LOGICAL ENDIN
      LOGICAL DIMYET, OPTYET
      INTEGER OPTSET
      INTEGER ARRDIM, ARRSUB, ISFUN, FARG
      INTEGER LSTAT, NSTAT, BNSTAT, STATNO, STAREF
      INTEGER LVAR, IVAR
      COMMON /CDO/ LDO, DOPEN, DOSPEC(30)
      COMMON /CERROR/ NUMST, NUMERR, ENDERR, LABENO, LABERR
      COMMON /CFOR1/ LFOR, NFOR, FORNXT(50,2), LJUMP, NJUMP,
     * JUMPS(500,2), ABNFOR
      COMMON /CIO/ NIN, NOUT, NTAB, ENDIN
      COMMON /COPT/ DIMYET, OPTYET, OPTSET
      COMMON /CSARG/ ARRDIM(26,2), ARRSUB(26), ISFUN(11,3),
     * FARG(26)
      COMMON /CSTAT/ LSTAT, NSTAT, BNSTAT, STATNO(500),
     * STAREF(500,2)
      COMMON /CVAR/ LVAR, IVAR(376,2)
C  CHECK PROGRAM CONTAINED AN END STATEMENT .
C  N.B. ERROR MESSAGE ALREADY IF STATEMENTS FOLLOW AN END
      IF (.NOT.ENDERR) CALL
     * ERROR(41HPROGRAM DOES NOT CONTAIN AN END STATEMENT, 41)
C  CHECK IF OPTION STATEMENT HAS BEEN USED THAT OPTION BASE 1
C  DOES NOT OCCUR WITH A ZERO DIMENSIONING
      IF (OPTSET.NE.1) GO TO 30
      DO 20 I=1,26
C  POSITIVE VALUE IN ARRSUB(I) INDICATES REFERENCE IN DIM STAT
        IF (ARRSUB(I).LE.0 .OR. ARRSUB(I).GT.2) GO TO 20
C  CHECK SUBSCRIPTS
        ISUBS = ARRSUB(I)
        DO 10 J=1,ISUBS
          IF (ARRDIM(I,J).EQ.0) CALL
     *     ERROR(
     *     48HARRAY DIMENSIONED LENGTH ZERO WITH OPTION BASE 1,
     *     48)
   10   CONTINUE
   20 CONTINUE
C  CHECK THAT THERE ARE NO CLASHES OF ARRAY AND SIMPLE
C  NUMERIC VARIABLE NAMES.
C  ARRAY CODES ARE 313-338 (INC.)
C  SIMPLE NUMERIC VARIABLES 1 TO 276 STEP 11
   30 KEYSNV = 1
      KEYARR = 313
      ONE = .FALSE.
      DO 60 I=1,26
        IF (IVAR(KEYSNV,1).EQ.0 .OR. IVAR(KEYARR,1).EQ.0) GO TO
     *   50
C  CLASH FOUND - IF FIRST ONE THEN OUTPUT TITLE
        IF (ONE) GO TO 40
        ONE = .TRUE.
        WRITE (NOUT,99998)
   40   CALL DCODE(CH, KEYSNV)
        WRITE (NOUT,99994) CH
   50   KEYSNV = KEYSNV + 11
        KEYARR = KEYARR + 1
   60 CONTINUE
C  CHECK ALL FORWARD REFERENCES HAVE OCCURRED
      IF (-1.EQ.BNSTAT) GO TO 70
      WRITE (NOUT,99997)
      IST = LSTAT - BNSTAT
      WRITE (NOUT,99996) (STATNO(I),I=IST,LSTAT)
C  CHECK NO ILLEGAL TRANSFER INTO FOR BLOCKS
   70 IF (.NOT.ABNFOR) GO TO 80
      WRITE (NOUT,99991)
      GO TO 110
C  FOR BLOCK TRANSFER CHECKS
   80 ONE = .FALSE.
      IF (NJUMP.EQ.0) GO TO 110
      DO 100 I=1,NJUMP
        IF (CHKFOR(.FALSE.,JUMPS(I,1),JUMPS(I,2))) GO TO 100
C  ILLEGAL JUMP
        IF (ONE) GO TO 90
C  OUTPUT TITLE
        WRITE (NOUT,99990)
        ONE = .TRUE.
   90   WRITE (NOUT,99999) JUMPS(I,1), JUMPS(I,2)
  100 CONTINUE
C  CHECK ALL FOR STATEMENTS HAVE MATCHING NEXT
  110 IF (DOPEN.EQ.0) GO TO 130
      WRITE (NOUT,99995)
      DO 120 I=1,DOPEN
        CALL DCODE(CH, DOSPEC(I))
        WRITE (NOUT,99994) CH
  120 CONTINUE
C  OUTPUT NUMBER OF STATEMENTS PROCESSED AND NUMBER OF ERROR MESSAGES
  130 WRITE (NOUT,99993) NUMST
      WRITE (NOUT,99992) NUMERR
      RETURN
99999 FORMAT (6X, 15HFROM STATEMENT , I6, 13H TO STATEMENT, I6)
99998 FORMAT (1X, 40H***ARRAY AND SIMPLE NUMERIC NAME CLASHES)
99997 FORMAT (46H ***FOLLOWING STATEMENT NUMBERS ARE REFERENCED,
     * 4H BUT, 13H DO NOT OCCUR)
99996 FORMAT (1H , 6I8)
99995 FORMAT (46H ***NEXT STATEMENTS MISSING FOR FOLLOWING CONT,
     * 4HROL , 9HVARIABLES)
99994 FORMAT (1H , 3A1)
99993 FORMAT (1H , I6, 22H  STATEMENTS PROCESSED)
99992 FORMAT (1H , I6, 23H  ERROR MESSAGES OUTPUT)
99991 FORMAT (46H *** ILLEGAL JUMPS INTO FOR BLOCKS-CHECKS ABAN,
     * 5HDONED)
99990 FORMAT (37H *** ILLEGAL TRANSFER INTO FOR BLOCKS)
      END
C***
C                     SUBROUTINE UPJUMP
C***
      SUBROUTINE UPJUMP(STAT, DEST)
C
C  UPDATES JUMPS ARRAY CONTAINING FORWARD REFERENCES
C   STAT = CURRENT STATEMENT NUMBER
C   DEST = DESTINATION STATEMENT
C
C..ARGUMENTS
      INTEGER DEST, STAT
C..COMMON BLOCKS
      LOGICAL ABNFOR
      INTEGER LFOR, NFOR, FORNXT, LJUMP, NJUMP, JUMPS
      COMMON /CFOR1/ LFOR, NFOR, FORNXT(50,2), LJUMP, NJUMP,
     * JUMPS(500,2), ABNFOR
C  RETURN IF ABNFOR IS TRUE
      IF (ABNFOR) GO TO 10
C  CHECK ENOUGH ROOM
      NJUMP = NJUMP + 1
      IF (NJUMP.GT.LJUMP) CALL SYSERR(5)
C  UPDATE
      JUMPS(NJUMP,1) = STAT
      JUMPS(NJUMP,2) = DEST
   10 RETURN
      END
C***
C                    SUBROUTINE UQSTR
C***
      SUBROUTINE UQSTR
C
C  IGNORE ALL LEADING AND TRAILING SPACES
C  ASSUME K3 POINTS AT THE FIRST NON-BLANK AND THAT
C  THE STRING IS TO BE TERMINATED BY A COMMA (59) OR
C  THE END OF THE LINE
C
C  A WARNING IS OUTPUT IF THE LENGTH OF THE STRING
C  EXCLUDING LEADING AND TRAILING SPACES IS GREATER
C  THAN 18 (MAXLEN)
C
C..LOCAL VARIABLES
      INTEGER UQ(4)
      INTEGER COMMA, I, ICH, K1, K2, MAXLEN, NUM, SPACE
C..FUNCTIONS
      INTEGER CODE
C..COMMON BLOCKS
      INTEGER K3, JCODE
      INTEGER LLINE, NLINE, MAXLIN, LINE
      COMMON /CNXTCH/ K3, JCODE
      COMMON /CLINE/ LLINE, NLINE, MAXLIN, LINE(80)
      DATA NUM, COMMA, MAXLEN, SPACE /4,59,18,44/
      DATA UQ(1), UQ(2), UQ(3), UQ(4) /44,36,37,40/
C  LET K1 POINT TO THE FIRST CHARACTER IN THE STRING
      K1 = K3
C  UNQUOTED STRING CANNOT BE NULL
      IF (LINE(K1).EQ.COMMA) GO TO 50
C  EAT LETTERS AND DIGITS
   10 JCODE = CODE(K3)
      IF (JCODE.NE.3) GO TO 30
C  CHECK NOT AT END OF STRING
      IF (LINE(K3).EQ.COMMA) GO TO 60
C  ELSE SPACE
      IF (LINE(K3).EQ.SPACE) GO TO 40
C  OTHER CHARACTER
      ICH = LINE(K3)
      DO 20 I=1,NUM
        IF (ICH.EQ.UQ(I)) GO TO 30
   20 CONTINUE
      CALL ERROR(41HNON-STANDARD CHARACTER IN UNQUOTED STRING, 41)
C  LETTER,DIGIT,OR LEGAL JCODE=3
   30 K2 = K3
   40 K3 = K3 + 1
      IF (K3.LE.NLINE) GO TO 10
      K3 = -1
      GO TO 70
C  NULL STRING ILLEGAL
   50 CALL ERROR(51HNULL OR BLANK STRING NOT ALLOWED AS UNQUOTED STRING,
     * 51)
      GO TO 70
   60 IF (K2-K1+1.GT.MAXLEN) CALL
     * ERROR(
     * 56HWARNING UNQUOTED STRING EXCEEDS MINIMAL SPECIFIED LENGTH, 56)
   70 RETURN
      END
C***
C                    SUBROUTINE XRSTAT
C***
      SUBROUTINE XRSTAT
C
C  ROUTINE TO PRINT OUT X-REF TABLES OF STATEMENT TYPES
C
C..LOCAL VARIABLES
      INTEGER ZT(9), TEMP(6)
      INTEGER I, IBLNK, IEND, II, IST, J, K, KEND, KST, L, SIX
      LOGICAL FIRST, ENDCH
C..COMMON BLOCKS
      INTEGER LCHAIN, NCHAIN, CHAIN
      INTEGER NIN, NOUT, NTAB
      LOGICAL ENDIN
      INTEGER KEYREF, LKEY, Z
      COMMON /CCHAIN/ LCHAIN, NCHAIN, CHAIN(5000)
      COMMON /CIO/ NIN, NOUT, NTAB, ENDIN
      COMMON /CKREF/ LKEY, KEYREF(21,2), Z(114)
C  SIX CONTROLS THE NUMBER OF REFERENCES OUTPUT/LINE
C  IF CHANGED THEN FORMAT STATEMENTS 102 AND 103
C  NEED CHANGING ACCORDINGLY
      DATA SIX, IBLNK /6,1H /
      WRITE (NTAB,99999)
      KEND = 0
      DO 100 II=1,LKEY
C  CALCULATE INDEXES IN Z ARRAY
        KST = KEND + 1
        KEND = KST + Z(KST)
        KST = KST + 1
C  TEST IF STATEMENT TYPE OCCURS IN PROGRAM
        IST = KEYREF(II,1)
        IF (IST.EQ.0) GO TO 100
C  INITIALIZE OTHER VARIABLE
        IEND = KEYREF(II,2)
        FIRST = .TRUE.
        ENDCH = .FALSE.
C  COLLECT REFERENCES SIX AT A TIME
   10   DO 30 J=1,SIX
          K = J
          TEMP(K) = CHAIN(IST)
C  CHECK IF LAST REFERENCE
          IF (IST.NE.IEND) GO TO 20
          ENDCH = .TRUE.
          GO TO 40
C  PICK UP NEXT REFERENCE
   20     IST = CHAIN(IST+1)
   30   CONTINUE
   40   IF (.NOT.FIRST) GO TO 80
        FIRST = .FALSE.
C  PICK UP NAME AND PAD WITH BLANKS
        I = 0
        DO 50 L=KST,KEND
          I = I + 1
          ZT(I) = Z(L)
   50   CONTINUE
        IF (I.EQ.9) GO TO 70
        I = I + 1
        DO 60 L=I,9
          ZT(L) = IBLNK
   60   CONTINUE
   70   WRITE (NTAB,99998) (ZT(I),I=1,9), (TEMP(I),I=1,K)
        GO TO 90
   80   WRITE (NTAB,99997) (TEMP(I),I=1,K)
   90   IF (.NOT.ENDCH) GO TO 10
  100 CONTINUE
      RETURN
99999 FORMAT (16X, 36HSTATEMENT TYPE CROSS REFERENCE TABLE/16X,
     * 36H------------------------------------)
99998 FORMAT (4X, 9A1, 2X, 1H-, 4X, 6I8)
99997 FORMAT (20X, 6I8)
      END
C***
C                    SUBROUTINE XRSTNO
C***
      SUBROUTINE XRSTNO
C
C  ROUTINE TO PRINT OUT X-REF TABLES FOR LINE NUMBERS
C  REFERENCED REMS ARE DENOTED BY A STAR FOLLOWING THE STATEMENT
C  NUMBER
C
C..LOCAL VARIABLES
      INTEGER TEMP(6)
      INTEGER I, IBLNK, IEND, IREM, IST, ISTAR, ISTAT, J, K, L, SIX
      LOGICAL ENDCH, FIRST
C..COMMON BLOCKS
      INTEGER LCHAIN, NCHAIN, CHAIN
      INTEGER NIN, NOUT, NTAB
      LOGICAL ENDIN
      INTEGER LSTAT, NSTAT, BNSTAT, STATNO, STAREF
      COMMON /CCHAIN/ LCHAIN, NCHAIN, CHAIN(5000)
      COMMON /CIO/ NIN, NOUT, NTAB, ENDIN
      COMMON /CSTAT/ LSTAT, NSTAT, BNSTAT, STATNO(500), STAREF(500,2)
      DATA ISTAR, IBLNK /1H*,1H /, SIX /6/
      WRITE (NTAB,99999)
C  LOOP THROUGH ALL STATEMENTS
      DO 90 I=1,NSTAT
C  TEST IF STATEMENTS REFERENCED
        IST = STAREF(I,1)
        IF (IST.EQ.0) GO TO 90
        IF (IST.GT.0) GO TO 10
C  REFERENCE NOT APPEARING AS STATEMENT IN PROGRAM
        CALL
     *   ERROR(
     *   54HFOLLOWING STATEMENT NUMBER APPEARS ONLY AS A REFERENCE, 54)
        IST = -IST
C  TEST IF REM STATEMENT
   10   IREM = IBLNK
        ISTAT = STATNO(I)
        IF (ISTAT.GT.0) GO TO 20
        IREM = ISTAR
        ISTAT = IABS(ISTAT)
C  INITIALIZE OTHER VARIABLES
   20   IEND = STAREF(I,2)
        FIRST = .TRUE.
        ENDCH = .FALSE.
C  COLLECT REFERENCES SIX AT A TIME
   30   DO 50 J=1,SIX
          K = J
          TEMP(K) = CHAIN(IST)
C  CHECK IF LAST REFERENCE
          IF (IST.NE.IEND) GO TO 40
          ENDCH = .TRUE.
          GO TO 60
C  PICK UP NEXT REFERENCE
   40     IST = CHAIN(IST+1)
   50   CONTINUE
   60   IF (.NOT.FIRST) GO TO 70
        FIRST = .FALSE.
        WRITE (NTAB,99998) ISTAT, IREM, (TEMP(L),L=1,K)
        GO TO 80
   70   WRITE (NTAB,99997) (TEMP(L),L=1,K)
C  CHECK IF END OF CHAIN
   80   IF (.NOT.ENDCH) GO TO 30
   90 CONTINUE
      RETURN
99999 FORMAT (17X, 33HLINE NUMBER CROSS REFERENCE TABLE/17X, 8H--------,
     * 25H-------------------------)
99998 FORMAT (6X, I5, 1X, A1, 2X, 1H-, 4X, 6I8)
99997 FORMAT (20X, 6I8)
      END
C***
C                    SUBROUTINE XRVARS
C***
      SUBROUTINE XRVARS
C
C  ROUTINE TO PRINT OUT X-REF TABLE FOR VARIABLES , ARRAYS
C  AND FUNCTIONS.
C
C..LOCAL VARIABLES
      INTEGER U(2,6)
      INTEGER I, ICODE, IE, IEND, IS, IST, K
      LOGICAL ONE
C..COMMON BLOCKS
      INTEGER NIN, NOUT, NTAB
      LOGICAL ENDIN
      INTEGER LVAR, IVAR
      COMMON /CIO/ NIN, NOUT, NTAB, ENDIN
      COMMON /CVAR/ LVAR, IVAR(376,2)
      DATA U(1,1), U(2,1), U(1,2), U(2,2), U(1,3), U(2,3),
     * U(1,4), U(2,4), U(1,5), U(2,5), U(1,6), U(2,6)
     * /1,286,287,312,313,338,339,364,365,375,376,376/
      WRITE (NTAB,99999)
C  LOOP THROUGH DIFFERENT TYPES
      DO 100 K=1,6
        ONE = .FALSE.
        IS = U(1,K)
        IE = U(2,K)
        DO 90 I=IS,IE
          IF (IVAR(I,1).EQ.0) GO TO 90
          IF (ONE) GO TO 80
C  WRITE HEADING
          GO TO (10, 20, 30, 40, 50, 60), K
   10     WRITE (NTAB,99998)
          GO TO 70
   20     WRITE (NTAB,99997)
          GO TO 70
   30     WRITE (NTAB,99996)
          GO TO 70
   40     WRITE (NTAB,99995)
          GO TO 70
   50     WRITE (NTAB,99994)
          GO TO 70
   60     WRITE (NTAB,99993)
   70     ONE = .TRUE.
   80     IST = IVAR(I,1)
          IEND = IVAR(I,2)
          ICODE = I
          CALL OCHAIN(IST, IEND, ICODE)
   90   CONTINUE
  100 CONTINUE
      RETURN
99999 FORMAT (12X, 41HVARIABLES AND FUNCTION CROSS REFERENCE TA,
     * 3HBLE/12X, 42H------------------------------------------,
     * 2H--)
99998 FORMAT (//17H SIMPLE VARIABLES)
99997 FORMAT (//17H STRING VARIABLES)
99996 FORMAT (//15H NUMERIC ARRAYS)
99995 FORMAT (//23H USER DEFINED FUNCTIONS)
99994 FORMAT (//19H STANDARD FUNCTIONS)
99993 FORMAT (//13H TAB FUNCTION)
      END
1 REM TEST PROGRAM
2 REMARK OTHER FORM OF REM
4 PRINT "TEST GOS"
5 LET A=0
0006GO TO0008
7 PRINT "GO ERROR"
8 DEF FNV=3
9 GOTO 14
12 GO      TO17
14 DIM V(3)
15 GOTO 12
17 LET A=A+1
18 IF A<4 THEN 6
20 GO SUB 24
21 GOTO 30
24 REM SUBROUTINE
25 RETURN
30 PRINT "TEST CONSTANTS"
32 PRINT  0.0; 1; 2.0; 03.0;  4E0; " SB 0 THRU 4"
00033 PRINT .5E+1;600E-2;0.07E2;-(-8),.0000000009E10; " SB 5 THRU 9"
34 PRINT 25.678900000000000000000000000000000234; " SB 25.6789"
35 PRINT-1.1*(-1.2);" SB 1.32"
36 PRINT 26070000000000000000123E-21;" SB 26.07"
37 PRINT -  36  ^ .5;  -7; - ( + 8 );  " IS -6 THRU -8"
38 PRINT 1E-38;1E+38; " ARE 1E-38 AND 1E+38"
39 PRINT  100E322,.001E-322; " ARE TOO LARGE AND TOO SMALL"

40 REM TEST PRINT FORMATS
41  PRINT"A "; "B";         "C";       "D "; "E SB A BCD E"
42 PRINT "1 TAB";TAB(.6);"3 TABS";TAB(3);"ENDTABS"
43 PRINT "1 TAB","3 TABS",;,,;;;
44 PRINT "ENDTABS"
45 PRINT "A";
46 PRINT;;;
47 PRINT;;"B SB AB"
48 PRINT;;,
49 PRINT"SB IDENTED ONE TAB"
50PRINT"LONGESTPOSSIBLE................................................"
51 PRINT "20 TABS";TAB(4*5)
52 LET X=1/3
53 PRINT "TOOLONG",X,X,X,X,X,X,X,X,X,X,X,X,X,X,X,X
54 PRINT "Y" ; "" ; "E" ;
55PRINT"";"S"; " SB YES (WITH NO SPACES IN IT)"
60 PRINT "TEST DEF"
61 GOTO 63
62 DEF FNA=1
63DEFFNB  (  X  )  =  X  +  1
64 DEF FNZ(Z9) =Z9*2+FNA+FNB(1+1)
65 DEF FNK(X)=X+FNB(X)+X
68 LET X=3
70PRINTFNA,FNB  (1),FNB(-(-1-1)),  FNB(FNB(2)),
71 PRINT FNZ(1/2),X+FNB(1)*FNB(1)-1,X+4
72IFFNA<>FNATHEN 78
73 PRINT 8;" SB 1 THRU 8"
74   IF  FNK(FNK   (10) + FNK(20) -1) =274 THEN 78
75 PRINT "FUNCTION ERROR 1 WITH:",FNK(FNK(10)+FNK(20)-1)
78 PRINT "TEST ON"
81 LET X3=3
82 ON 1 GOTO 85
83 PRINT "ON ERROR 1"
85 ON X3+6-6 GOTO 86,86,87,86
86 PRINT "ON ERROR 2"
87ON(SGN(RND))GOTO   88,89
88 ON 2*X3/X3+X3 GOTO 89,89,89,89,90
89 PRINT "ON ERROR 3"
90 PRINT "END ON TESTS"
100 REM IF TESTS (FIRST NON-JUMPS)
101 IF 1<>1 THEN 103
102 PRINT 1
103 IF 1=1+1 THEN 105
104 PRINT 2
105 IF1>1 THEN 107
106 PRINT 3
107 IF 1<=6*0 THEN 109
108 PRINT 4
109 IF 6<6 THEN 111
110 PRINT 5
111 IF 1>2 THEN 113
112 PRINT 6
113 IF 1<0 THEN 115
114 PRINT 7
115 IF 1 + 1 >=  1 + 2  THEN  117
116 PRINT 8
117 REM END NON-JUMPS NOW TRY JUMPS
120 PRINT " SB 1 THRU 8"
121 IF 1+1=2 THEN 123
122 PRINT -1
123 IF1<>2 THEN 125
124 PRINT-2
125 IF1>0THEN127
126 PRINT-3
127IF1>=1E0THEN129
128 PRINT-4
129 IF-1*1 >=-1-1 THEN 131
130 PRINT-5
131 IF -2<-1 THEN 133
132 PRINT-6
133 IF 0<=0 THEN 135
134 PRINT-7
135 IF 1<3/1 THEN 139
136 PRINT-8
139 GOTO 200
150 REM USE ALL VARIABLE NAMES
151 PRINT A,A0,A1,A2,A3,A4,A5,A6,A7,A8,A9
152 PRINT B,B1,B2,B3,B4,B5,B6,B7,B8,B9
153 PRINT C,C1,C2,C3,C4,C5,C6,C7,C8,C9
154 PRINT D,D0,D1,D2,D3,D4,D5,D6,D7,D8,D9
155 PRINT E9,E8,E7,E6,E5,E4,E3,E2,E1,E
156 PRINT F,F1,F2,F3,F4,F5,F6,F7,F8,F9
157 PRINT G,G1,G2,G3,G4,G5,G6,G7,G8,G9
158 PRINT H,H1,H2,H3,H4,H5,H6,H7,H8,H9
159 PRINT I,I1,I2,I3,I4,I5,I6,I7,I8,I9
160 PRINT J,J1,J2,J3,J4,J5,J6,J7,J8,J9
161 PRINT K1,K2,K3,K4,K5,K6,K7,K8,K9
162 PRINT L,L1,L2,L3,L4,L5,L6,L7,L8,L9
163 PRINT N,N1,N2,N3,N4,N5,N6,N7,N8,N9
164 PRINT M,M1,M2,M3,M4,M5,M6,M7,M8,M9
165 PRINT O,O1,O2,O3,O4,O5,O6,O7,O8,O9
166 PRINT P,P1,P2,P3,P4,P5,P6,P7,P8,P9
167 PRINT Q,Q1,Q2,Q3,Q4,Q5,Q6,Q7,Q8,Q9
168 PRINT S,S1,S2,S3,S4,S5,S6,S7,S8,S9
169 PRINT T,T0,T1,T2,T3,T4,T5,T6,T7,T8,T9
170 PRINT U,U1,U2,U3,U4,U5,U6,U7,U8,U9,U0
171 PRINT V,V0,V1,V2,V3,V4,V5,V6,V7,V8,V9
172 PRINT W1,W,W0,W2,W3,W4,W5,W6,W7,W8,W9
174 PRINT X,X0,X1,X2,X3,X4,X5,X6,X7,X8,X9
175 PRINT Y,Y1,Y2,Y3,Y4,Y5,Y6,Y7,Y8,Y9
176 PRINT Z,Z1,Z0,Z2,Z3,Z4,Z5,Z6,Z7,Z8,Z9
180 PRINT A$,B$,C$,D$,E$,F$,G$
181 PRINT H$,I$,J$,K$,L$,M$,N$
182 PRINT O$,P$,Q$,R$,S$,T$
184 PRINT    V$,W$,X$,Y$,Z$
185 PRINT R,R0,R1,R2,R3,R4,R5,R6,R7,R8,R9
186 PRINT B0,C0,E0,F0,G0,H0,I0,J0,K0,K,L0
187 PRINT M0,N0,O0,P0,U$,Q0,S0,Y0
200 PRINT "GOSUB TESTS"
202 GOSUB 500
204 GOSUB 210
206 REM THIS SUBROUTINE NEVER RETURNS
210 GOSUB 500
212 PRINT" SB XX"
214 LET X1=9
216 LET X2=5*2
218 GOSUB 600
220 PRINT " SB 987654321"
222 PRINT F;" SB 90"
240 PRINT "TEST FORS"
242 FOR I=1 TO 3
244 PRINT I,
246 NEXT I
248 PRINT " SB 1 THRU 3"
252 LET E=2
254 FOR A=0 TO E
255 DEF FNY=-1
256 FOR Z9=-FNY-2 TO 3*(-1) STEP -(-FNY)
258 PRINT 3*A-Z9
260 NEXT Z9
261 LET E=0
262 NEXT A
264 PRINT " SB 123456789"
266 PRINT A," SB 3",Z9;" SB -4"
268 LET P=0
270 FORA=1TO3-PSTEPP
272  LET P=P+1
274 PRINT A+P;
276 IF P>4 THEN 280
278 NEXT A
280 PRINT " SB 23456"
286 FOR V=20 TO 16  STEP -1
288 IF V=18 THEN 300
290 REM RETURN HERE ON GOSUB MUCH LATER
291 IF V>18 THEN 294
292 PRINT V;
294 NEXT V
296 PRINT V;" SB 18 THRU 15"
298 RETURN
300 FOR I=1 TO 7 STEP 3
302 GO SUB 330
304 GOTO 320
306 PRINT I,X1,FNY*FNY*X2;
308 FOR J=4 TO 2 STEP-9
310   GOTO 314
312 NEXT J
314 NEXT I
316 PRINT " SB 123456789"
318 GO TO 350
320 LET X1=I+1
322 GOTO 306
330 LET X2=I+2
332 RETURN
350 FOR I=1 TO 0
352 PRINT "FOR ERROR 1"
354 NEXT I
356 FOR I=1 TO 2 STEP-1
358 PRINT "FOR ERROR 2"
360 NEXT I
362 FOR K=0 TO 0
364 PRINT K;
366 NEXT K
368 FOR I=0 TO 0 STEP -(-FNY)
370 PRINT I+1;
372 NEXT I
374 PRINT" SB 01"
376 LET P=0
378 FOR I=1 TO 2
380 LET P=P+1
382 IF P<5000 THEN 378
384 NEXT I
386 PRINT I,P," SB 3,5001"
388 LET P=10
389 LET Q=1
390 FOR I=1 TO P STEP Q
392 PRINT I;
394 LET P=3
396 LET I=I+P
398 LET Q=0
399 NEXT I
400 PRINT I; "SB 1,5,9,13"
410 FOR I=1 TO 3
412 FOR I=6 TO 9
414 PRINT I;
416 NEXT I
418 GOTO 422
420 NEXT I
422 PRINT I;" SB 6 THRU 10"
430 PRINT "10 NESTED FORS -- NB V IS STILL ACTIVE AT 286"
432 FOR A=1 TO 1
434 FOR B=2 TO 2
436 FOR C=-3 TO -3
438 FOR D=4 TO 4 STEP -1
440 FOR E=5 TO 5 STEP-1
444 PRINT A;B; -C;D;E;
446 FOR F=-6 TO -6 STEP -1
448 FOR G=7 TO 7
450 FOR H=8 TO 8
452 FOR I=9 TO 9
454 PRINT -F; G; H; I; " SB 1 THRU 9"
456 NEXT I
458 NEXT H
460 NEXT G
462 NEXT F
464 NEXT E
466 NEXT D
468 NEXT C
470 NEXT B
472 NEXT A
480 GOSUB 290
498 PRINT "END FOR TESTS"
499 GOTO 640
500 REM SUBROUTINE 1
502 PRINT  "X" ;
504 RETURN
600 REM RECURSIVE MULTIPLY SUBROUTINE : X1*X2
605 DEF FNO=1
610 PRINT X1;
615 IF X1=FNO THEN 630
618 LET X1=X1-FNO
620 GOSUB 605
622 LET F=F+X2
624 RETURN
630 LET F=X2
632 RETURN
640 PRINT "TEST RANDOM NUMBERS"
641 PRINT RND,RND," SHOULD BE THE SAME 2 VALUES EVERY RUN"
642 RANDOMIZE
643 PRINT RND,RND," SHOULD BOTH CHANGE (ALMOST) EVERY RUN"
644 RANDOMIZE
645 PRINT RND,RND," SHOULD BOTH CHANGE (ALMOST) EVERY RUN"
646 LET E=9
647 LET A=9
650 LET E$="EIGHTEEN CHAR STRI"
652 LET N$=""
654 LET F$=E$
655 IF A<>E THEN 658
656 LET G$="NG"
658 PRINT F$;""; N$; G$; " SB EIGHTEEN CHAR STRING"
670 PRINT "COMPARISON OF STRINGS"
672 IF E$<>E$ THEN 674
673 PRINT "A";
674 IF N$<>"" THEN 676
675 PRINT "B";
676 IF "PIG"<>"PIG" THEN 678
677 PRINT "C";
678 IF"" = " " THEN 680
679 PRINT "D";
680 IF "PIG"="PIT" THEN 682
681 PRINT "E";
682 IF G$="EIGHTEEN CHAR PTRI" THEN 684
683 PRINT "F";
684 IF E$ > E$ THEN 686
685 PRINT "G";
686 IF E$<E$THEN 688
687 PRINT "H";
688 IF"A">"B" THEN 690
689 PRINT "I";
690 PRINT " SB ABCDEFGHI"
691 PRINT "J";
692 IF"A">="A:" THEN 694
693 PRINT "K";
694 IF "A:"<="A" THEN 696
695 PRINT "L";
696 IF E$<="EIGHTEEN CHAR STRG" THEN 698
697 PRINT "M";
698 IF":"<""THEN 700
699 PRINT "N";
700 IF "2"<"1" THEN 710
701 PRINT "O";
710IFE$=F$THEN712
711 PRINT " STRING ERROR  1"
712 IF  ""  ="" THEN 714
713 PRINT " STRING ERROR  2"
714 IF E$<>"EIGHTEEN CHAR STRG" THEN 716
715 PRINT " STRING ERROR  3"
716 IF E$ >"EIGHTEEN CHAR STRG" THEN 718
717 PRINT " STRING ERROR  4"
718 IF":">  "" THEN 720
719 PRINT " STRING ERROR  5"
720 IF "EIGHTEEN CHAR STRG" <E$ THEN 722
721 PRINT " STRING ERROR  6"
722 IF N$ < " " THEN 724
723 PRINT " STRING ERROR  7"
724 IF E$>=E$ THEN 726
725 PRINT " STRING ERROR   8"
726 IF E$<=E$ THEN 728
727 PRINT " STRING ERROR   9"
728 IF "012345678901"<="012345678911" THEN 730
729 PRINT " STRING ERROR 10"
730 IF ":">="" THEN 732
731 PRINT " STRING ERROR 11"
732 PRINT "P SB JKLMNOP"
750 PRINT "EXPRESSION EVALUATION TESTS"
752 PRINT 3-1-1; 1+2*.5; 15-4*3; 56/7/2; " SB 1 THRU 4"
754 DEF FNU(X)=X+1*1
756 LET U(3,4)=2
758 PRINT (2+8)/2; (((4))+(-(-(2))));FNU(4+6/3); U(6/3+1,3*2-2)^4-8;
760 PRINT " SB 5 THRU 8"
762 PRINT3-(2+U(-5+4*2,6 +   FNU(3^2+6)-18) ) +6; " SB 5", 2^3^4; " SB 4
764 PRINT-2^2,-(+1+2^2);-2*9^.5;-56/2^3; " SB -4 THRU -7"
766 PRINT(1E38+1E-38)-(1E38-1E-38)+5.7; " SB 5.7"
768 IF 1+2*3^4=168-125/5^2 THEN 770
769 PRINT "EXPRESSION EVALUATION ERROR"
770 PRINT 6*10/4; 2^2*4; 3/3*17; 1*3*1*3*2*1/1; " SB 15 THRU 18"
772 PRINT-3^2; -4*2,-8+1; -(+(-(+(-5))))-1; " SB -9 THRU -6"
800 PRINT "ARRAY TESTS"
802 DIM A(1),B(1,2),C(3,4), D(5,11)
804 LET A(0)=1
806 LET A(1)=2
808 LET B(0,0)=3
810 LET B(A(0),2)=4
812 LET X(0)=5
814 LET X(10)=6
816 LET Y(0,0)=7
818 LET Y(10,10)=Y(0,0)+A(0)
820 PRINT A(0);A(A(A(0))-1);B(0,0);B(1,3-1);  " SB 1 THRU 4"
822 PRINT X(0); X(10); Y(2*0,0);Y(10,10);  " SB 5 THRU 8"
824 DEF FNC=M(N+M+N(0,A(0)-1)-2)
826 LET N(0,0)=10
828 LET M(10)=9
829 LET M=5
830 LET N=-M+2
832 LET M(0)=N(0,0)-2
834 PRINT FNC;M(.49); M(10.49)-2;
836 LET X(9)=10.4
838 PRINT M(X(M(X( FNC+1-1)-.3))+1-SGN(N(0,0)))^.5*2;  " SB 9 THRU 6"
850 FOR I=1 TO 3
852 FOR J=0 TO 4
854 GOTO 856
856 DIM Q(3,4)
858 DEF FNF=2
859 LET Q(I,J)=FNF^(I-1)
860 IF I=1 THEN 862
861 LET Q(I,J)=Q(I,J)+Q(I-1,J)
862 FOR K=1 TO J
864 LET Q(I,K)=Q(I,K)+Q(I,K-1)
866 NEXT K
868 NEXT J
870 NEXT I
872 PRINT 2^Q(1,2); Q(1,4); Q(2,4); Q(3,4);  " SB 8192,23,156,642 "
874 LET X(FNC+X(3*3)-INT(11.9)-RND*.4)= 11
876 PRINT X(N(0,0)^A(0)-2)^A(1);  " SB 121"
900 PRINT "TEST DATA AND INPUT"
902 GOTO 904
904 DATA 3 , "EIGHTEEN CHAR STRI", EIGHTEEN CHAR STRI
906 LET E$="EIGHTEEN CHAR STRI"
908 READ X
910 GO SUB 1050
918DATA""
926 DATA 3.0,4.0 ,  .05E2  ,600E-02,.007E+3,8.00000001
928 FOR I=1 TO 6
930 READ J
932 PRINT J;
934 NEXT I
936 PRINT " SB 3 THRU 8"
938DATA                                      -4,+5,-60E-1,2,10,4
940 READ A,B,C
942 PRINT A,-B,C," SB -4 THRU -6"
944 LET I=3
946 READ I,X(I),X ( X ( I ) )
948 PRINT I,X(2),X(10)," SB 2,10,4"
950 READ I,J,I,J,X(2),X(J)
952 DATA 20,200,1,2
953 DATA 2000,.30
954 PRINT I,J,X(2)*10, " IS 1 THRU 3"
956 DEF FNH(I)=X(I+1)-14
958 LET X(6)=20
960 READ  J,X(FNH(J))
962 DATA 5,10
964 PRINT J,X(6)," SB 5,10"
966 DATA"   ",  .  ,",..."
968 READ A$,B$,C$
970 PRINT "+.+" ; A$ ; "+";B$;"+";C$; " SB +.+   +.+,..."
972 DATA AZ09* ):$  ,  =<>-(..+E;/.
974 DATA"AZ09* ):$" , "=<>-(..+E;/."
976 READ  A$,B$,Y$,Z$
978 PRINT A$;B$;Y$;Z$
979 PRINT " SB AZ09* ):$=<>-(..+E;/.  (REPEATED TWICE)"
980 RESTORE
982 READ Y
984 PRINT X,Y," SB 3,3"
985 GOSUB 1050
986 FOR I=1 TO 20
988 RESTORE
990 NEXT I
992 FOR J=1 TO 9
994 READ C$
996 NEXT J
998 PRINT C$," SB .007E+3"
1000 GO TO 1100
1050 REM SUBROUTINE TO CHECK STRING INPUT
1052  READ F$,G$
1053 READ N$
1054 GO TO 1058
1056 INPUT F$,G$
1057 INPUT N$
1058 IF F$<>G$ THEN 1066
1060 IF F$=E$ THEN 1068
1066 PRINT " DATA ERROR 1 WITH:";F$,G$
1068 IF N$="" THEN 1072
1070 PRINT " DATA ERROR 2 WITH:";N$
1072 LET F$="RUBBISH1"
1074 LET G$="RUBBISH2"
1076 LET N$="RUBBISH3"
1078 RETURN
1100 PRINT "NOW REPEAT USING INPUT FOR READ"
1108 INPUT X0
1110 GOSUB 1056
1128 INPUT J1,J2,J3,J4,J5,J6
1130 PRINT J1,J2,J3
1134 PRINT J4,J5,J6
1136 PRINT " IS 3 THRU 8"
1140 INPUT A,B,C
1142 PRINT A,-B,C," IS -4 THRU -6"
1146 INPUT  I,X(I),X(X(I))
1148 PRINT I,X(2),X(10)," IS 2,10,4"
1150 INPUT I,J0,I,J0,R(2),R(J0)
1154 PRINT I,J0,R(2)*10, " IS 1 THRU 3"
1158 LET X(6)=20
1160 INPUT J0,X(FNH(J0))
1164 PRINT J0,X(6)," IS 5,10"
1166 LET C$="1234567890123456"
1168 INPUT A$,B$,C$
1170PRINT "+.+" ; A$ ; "+";B$;"+";C$; " SB +.+   +.+,..."
1176 INPUT A$,B$
1177 INPUT P$,Q$
1178 PRINT A$ ; B$;P$;Q$
1179PRINT " SB AZ09* ):$=<>-(..+E;/.  (REPEATED TWICE)"
1184 PRINT X0,X,Y," IS 3,3,3"
1190 REM NOW INTERMIX READ WITH INPUT
1192 RESTORE
1194 READ X
1196 INPUT X0
1198 READ F$
1200 INPUT S$,T$
1201 INPUT G$
1202 READ G$,N$
1204 GOSUB 1058
1206 PRINT X,X0,S$,T$," IS 3 THRU 6"
 5000 REM TEST SPACING ERRORS
5001 DEF FN L=1
5002 DEF F ND=1
5003 RANDOMIZ E
5004 PRINT A $
5005 LET A 1=3
5006 PRINT SI N(X)
5007 DEF FNJ=RN D
5008 G O TO 5009
5009 IF A> =3 THEN 5010
5010 IF S< > S THEN 5011
5011 FOR A1=1 TO 3 STE P 6
5013 NEXT A 1
5014 PRINT FN J
5015 PRINT 23 45
5016 PRINT 2. 1
5017 PRINT 5.6E 9
5018 PRINT 1.2E- 9
31000 STOP
31001 PRINT "ERROR IN STOP"
31999 END
.
.
 1 REM TEST PROGRAM
 2 REMARK OTHER FORM OF REM
 ***NO SPACES FOLLOW KEYWORD
 4 PRINT "TEST GOS"
 5 LET A=0
 0006GO TO0008
 ***NO SPACE FOLLOWING STATEMENT NUMBER
 ***NO SPACE FOLLOWS KEYWORD
 7 PRINT "GO ERROR"
 8 DEF FNV=3
 9 GOTO 14
 12 GO      TO17
 ***NO SPACE FOLLOWS KEYWORD
 14 DIM V(3)
 15 GOTO 12
 17 LET A=A+1
 18 IF A<4 THEN 6
 20 GO SUB 24
 21 GOTO 30
 24 REM SUBROUTINE
 25 RETURN
 30 PRINT "TEST CONSTANTS"
 32 PRINT  0.0; 1; 2.0; 03.0;  4E0; " SB 0 THRU 4"
 00033 PRINT .5E+1;600E-2;0.07E2;-(-8),.0000000009E10; " SB 5 THRU 9"
 34 PRINT 25.678900000000000000000000000000000234; " SB 25.6789"
 35 PRINT-1.1*(-1.2);" SB 1.32"
 ***SPACES MUST PRECEDE AND FOLLOW KEYWORD
 36 PRINT 26070000000000000000123E-21;" SB 26.07"
 37 PRINT -  36  ^ .5;  -7; - ( + 8 );  " IS -6 THRU -8"
 38 PRINT 1E-38;1E+38; " ARE 1E-38 AND 1E+38"
 39 PRINT  100E322,.001E-322; " ARE TOO LARGE AND TOO SMALL"
 ***WARNING EXPONENT VALUE EXCEEDS MINIMAL REQUIREMENT
 ***WARNING EXPONENT VALUE EXCEEDS MINIMAL REQUIREMENT

 ***BLANK LINE ENCOUNTERED IN INPUT-IGNORED
 40 REM TEST PRINT FORMATS
 41  PRINT"A "; "B";         "C";       "D "; "E SB A BCD E"
 ***SPACES MUST PRECEDE AND FOLLOW KEYWORD
 42 PRINT "1 TAB";TAB(.6);"3 TABS";TAB(3);"ENDTABS"
 43 PRINT "1 TAB","3 TABS",;,,;;;
 44 PRINT "ENDTABS"
 45 PRINT "A";
 46 PRINT;;;
 ***SPACES MUST PRECEDE AND FOLLOW KEYWORD
 47 PRINT;;"B SB AB"
 ***SPACES MUST PRECEDE AND FOLLOW KEYWORD
 48 PRINT;;,
 ***SPACES MUST PRECEDE AND FOLLOW KEYWORD
 49 PRINT"SB IDENTED ONE TAB"
 ***SPACES MUST PRECEDE AND FOLLOW KEYWORD
 50PRINT"LONGESTPOSSIBLE................................................
 ***NO SPACE FOLLOWING STATEMENT NUMBER
 ***SPACES MUST PRECEDE AND FOLLOW KEYWORD
 51 PRINT "20 TABS";TAB(4*5)
 52 LET X=1/3
 53 PRINT "TOOLONG",X,X,X,X,X,X,X,X,X,X,X,X,X,X,X,X
 54 PRINT "Y" ; "" ; "E" ;
 55PRINT"";"S"; " SB YES (WITH NO SPACES IN IT)"
 ***NO SPACE FOLLOWING STATEMENT NUMBER
 ***SPACES MUST PRECEDE AND FOLLOW KEYWORD
 60 PRINT "TEST DEF"
 61 GOTO 63
 62 DEF FNA=1
 63DEFFNB  (  X  )  =  X  +  1
 ***NO SPACE FOLLOWS KEYWORD
 64 DEF FNZ(Z9) =Z9*2+FNA+FNB(1+1)
 65 DEF FNK(X)=X+FNB(X)+X
 68 LET X=3
 70PRINTFNA,FNB  (1),FNB(-(-1-1)),  FNB(FNB(2)),
 ***NO SPACE FOLLOWING STATEMENT NUMBER
 ***SPACES MUST PRECEDE AND FOLLOW KEYWORD
 71 PRINT FNZ(1/2),X+FNB(1)*FNB(1)-1,X+4
 72IFFNA<>FNATHEN 78
 ***NO SPACE FOLLOWING STATEMENT NUMBER
 ***NO SPACE FOLLOWS KEYWORD
 ***SPACES MUST PRECEDE AND FOLLOW KEYWORD
 73 PRINT 8;" SB 1 THRU 8"
 74   IF  FNK(FNK   (10) + FNK(20) -1) =274 THEN 78
 75 PRINT "FUNCTION ERROR 1 WITH:",FNK(FNK(10)+FNK(20)-1)
 78 PRINT "TEST ON"
 81 LET X3=3
 82 ON 1 GOTO 85
 ***WARNING - NO VARIABLE CONTROLLING ON STATEMENT
 83 PRINT "ON ERROR 1"
 85 ON X3+6-6 GOTO 86,86,87,86
 86 PRINT "ON ERROR 2"
 87ON(SGN(RND))GOTO   88,89
 ***NO SPACE FOLLOWS KEYWORD
 ***SPACES MUST PRECEDE AND FOLLOW KEYWORD
 88 ON 2*X3/X3+X3 GOTO 89,89,89,89,90
 89 PRINT "ON ERROR 3"
 90 PRINT "END ON TESTS"
 100 REM IF TESTS (FIRST NON-JUMPS)
 101 IF 1<>1 THEN 103
 ***WARNING - NO VARIABLES IN RELATIONAL EXPRESSIONS
 102 PRINT 1
 103 IF 1=1+1 THEN 105
 ***WARNING - NO VARIABLES IN RELATIONAL EXPRESSIONS
 104 PRINT 2
 105 IF1>1 THEN 107
 ***NO SPACE FOLLOWS KEYWORD
 ***WARNING - NO VARIABLES IN RELATIONAL EXPRESSIONS
 106 PRINT 3
 107 IF 1<=6*0 THEN 109
 ***WARNING - NO VARIABLES IN RELATIONAL EXPRESSIONS
 108 PRINT 4
 109 IF 6<6 THEN 111
 ***WARNING - NO VARIABLES IN RELATIONAL EXPRESSIONS
 110 PRINT 5
 111 IF 1>2 THEN 113
 ***WARNING - NO VARIABLES IN RELATIONAL EXPRESSIONS
 112 PRINT 6
 113 IF 1<0 THEN 115
 ***WARNING - NO VARIABLES IN RELATIONAL EXPRESSIONS
 114 PRINT 7
 115 IF 1 + 1 >=  1 + 2  THEN  117
 ***WARNING - NO VARIABLES IN RELATIONAL EXPRESSIONS
 116 PRINT 8
 117 REM END NON-JUMPS NOW TRY JUMPS
 120 PRINT " SB 1 THRU 8"
 121 IF 1+1=2 THEN 123
 ***WARNING - NO VARIABLES IN RELATIONAL EXPRESSIONS
 122 PRINT -1
 123 IF1<>2 THEN 125
 ***NO SPACE FOLLOWS KEYWORD
 ***WARNING - NO VARIABLES IN RELATIONAL EXPRESSIONS
 124 PRINT-2
 ***SPACES MUST PRECEDE AND FOLLOW KEYWORD
 125 IF1>0THEN127
 ***NO SPACE FOLLOWS KEYWORD
 ***WARNING - NO VARIABLES IN RELATIONAL EXPRESSIONS
 ***SPACES MUST PRECEDE AND FOLLOW KEYWORD
 126 PRINT-3
 ***SPACES MUST PRECEDE AND FOLLOW KEYWORD
 127IF1>=1E0THEN129
 ***NO SPACE FOLLOWS KEYWORD
 ***WARNING - NO VARIABLES IN RELATIONAL EXPRESSIONS
 ***SPACES MUST PRECEDE AND FOLLOW KEYWORD
 128 PRINT-4
 ***SPACES MUST PRECEDE AND FOLLOW KEYWORD
 129 IF-1*1 >=-1-1 THEN 131
 ***NO SPACE FOLLOWS KEYWORD
 ***WARNING - NO VARIABLES IN RELATIONAL EXPRESSIONS
 130 PRINT-5
 ***SPACES MUST PRECEDE AND FOLLOW KEYWORD
 131 IF -2<-1 THEN 133
 ***WARNING - NO VARIABLES IN RELATIONAL EXPRESSIONS
 132 PRINT-6
 ***SPACES MUST PRECEDE AND FOLLOW KEYWORD
 133 IF 0<=0 THEN 135
 ***WARNING - NO VARIABLES IN RELATIONAL EXPRESSIONS
 134 PRINT-7
 ***SPACES MUST PRECEDE AND FOLLOW KEYWORD
 135 IF 1<3/1 THEN 139
 ***WARNING - NO VARIABLES IN RELATIONAL EXPRESSIONS
 136 PRINT-8
 ***SPACES MUST PRECEDE AND FOLLOW KEYWORD
 139 GOTO 200
 150 REM USE ALL VARIABLE NAMES
 151 PRINT A,A0,A1,A2,A3,A4,A5,A6,A7,A8,A9
 152 PRINT B,B1,B2,B3,B4,B5,B6,B7,B8,B9
 153 PRINT C,C1,C2,C3,C4,C5,C6,C7,C8,C9
 154 PRINT D,D0,D1,D2,D3,D4,D5,D6,D7,D8,D9
 155 PRINT E9,E8,E7,E6,E5,E4,E3,E2,E1,E
 156 PRINT F,F1,F2,F3,F4,F5,F6,F7,F8,F9
 157 PRINT G,G1,G2,G3,G4,G5,G6,G7,G8,G9
 158 PRINT H,H1,H2,H3,H4,H5,H6,H7,H8,H9
 159 PRINT I,I1,I2,I3,I4,I5,I6,I7,I8,I9
 160 PRINT J,J1,J2,J3,J4,J5,J6,J7,J8,J9
 161 PRINT K1,K2,K3,K4,K5,K6,K7,K8,K9
 162 PRINT L,L1,L2,L3,L4,L5,L6,L7,L8,L9
 163 PRINT N,N1,N2,N3,N4,N5,N6,N7,N8,N9
 164 PRINT M,M1,M2,M3,M4,M5,M6,M7,M8,M9
 165 PRINT O,O1,O2,O3,O4,O5,O6,O7,O8,O9
 166 PRINT P,P1,P2,P3,P4,P5,P6,P7,P8,P9
 167 PRINT Q,Q1,Q2,Q3,Q4,Q5,Q6,Q7,Q8,Q9
 168 PRINT S,S1,S2,S3,S4,S5,S6,S7,S8,S9
 169 PRINT T,T0,T1,T2,T3,T4,T5,T6,T7,T8,T9
 170 PRINT U,U1,U2,U3,U4,U5,U6,U7,U8,U9,U0
 171 PRINT V,V0,V1,V2,V3,V4,V5,V6,V7,V8,V9
 172 PRINT W1,W,W0,W2,W3,W4,W5,W6,W7,W8,W9
 174 PRINT X,X0,X1,X2,X3,X4,X5,X6,X7,X8,X9
 175 PRINT Y,Y1,Y2,Y3,Y4,Y5,Y6,Y7,Y8,Y9
 176 PRINT Z,Z1,Z0,Z2,Z3,Z4,Z5,Z6,Z7,Z8,Z9
 180 PRINT A$,B$,C$,D$,E$,F$,G$
 181 PRINT H$,I$,J$,K$,L$,M$,N$
 182 PRINT O$,P$,Q$,R$,S$,T$
 184 PRINT    V$,W$,X$,Y$,Z$
 185 PRINT R,R0,R1,R2,R3,R4,R5,R6,R7,R8,R9
 186 PRINT B0,C0,E0,F0,G0,H0,I0,J0,K0,K,L0
 187 PRINT M0,N0,O0,P0,U$,Q0,S0,Y0
 200 PRINT "GOSUB TESTS"
 202 GOSUB 500
 204 GOSUB 210
 206 REM THIS SUBROUTINE NEVER RETURNS
 210 GOSUB 500
 212 PRINT" SB XX"
 ***SPACES MUST PRECEDE AND FOLLOW KEYWORD
 214 LET X1=9
 216 LET X2=5*2
 218 GOSUB 600
 220 PRINT " SB 987654321"
 222 PRINT F;" SB 90"
 240 PRINT "TEST FORS"
 242 FOR I=1 TO 3
 244 PRINT I,
 246 NEXT I
 248 PRINT " SB 1 THRU 3"
 252 LET E=2
 254 FOR A=0 TO E
 255 DEF FNY=-1
 256 FOR Z9=-FNY-2 TO 3*(-1) STEP -(-FNY)
 258 PRINT 3*A-Z9
 260 NEXT Z9
 261 LET E=0
 262 NEXT A
 264 PRINT " SB 123456789"
 266 PRINT A," SB 3",Z9;" SB -4"
 268 LET P=0
 270 FORA=1TO3-PSTEPP
 ***NO SPACE FOLLOWS KEYWORD
 ***SPACES MUST PRECEDE AND FOLLOW KEYWORD
 ***SPACES MUST PRECEDE AND FOLLOW KEYWORD
 272  LET P=P+1
 274 PRINT A+P;
 276 IF P>4 THEN 280
 278 NEXT A
 280 PRINT " SB 23456"
 286 FOR V=20 TO 16  STEP -1
 288 IF V=18 THEN 300
 290 REM RETURN HERE ON GOSUB MUCH LATER
 291 IF V>18 THEN 294
 292 PRINT V;
 294 NEXT V
 296 PRINT V;" SB 18 THRU 15"
 298 RETURN
 300 FOR I=1 TO 7 STEP 3
 302 GO SUB 330
 304 GOTO 320
 306 PRINT I,X1,FNY*FNY*X2;
 308 FOR J=4 TO 2 STEP-9
 ***SPACES MUST PRECEDE AND FOLLOW KEYWORD
 310   GOTO 314
 312 NEXT J
 314 NEXT I
 316 PRINT " SB 123456789"
 318 GO TO 350
 320 LET X1=I+1
 322 GOTO 306
 ***ILLEGAL TRANSFER INTO FOR BLOCK
 330 LET X2=I+2
 332 RETURN
 350 FOR I=1 TO 0
 352 PRINT "FOR ERROR 1"
 354 NEXT I
 356 FOR I=1 TO 2 STEP-1
 ***SPACES MUST PRECEDE AND FOLLOW KEYWORD
 358 PRINT "FOR ERROR 2"
 360 NEXT I
 362 FOR K=0 TO 0
 364 PRINT K;
 366 NEXT K
 368 FOR I=0 TO 0 STEP -(-FNY)
 370 PRINT I+1;
 372 NEXT I
 374 PRINT" SB 01"
 ***SPACES MUST PRECEDE AND FOLLOW KEYWORD
 376 LET P=0
 378 FOR I=1 TO 2
 380 LET P=P+1
 382 IF P<5000 THEN 378
 384 NEXT I
 386 PRINT I,P," SB 3,5001"
 388 LET P=10
 389 LET Q=1
 390 FOR I=1 TO P STEP Q
 392 PRINT I;
 394 LET P=3
 396 LET I=I+P
 398 LET Q=0
 399 NEXT I
 400 PRINT I; "SB 1,5,9,13"
 410 FOR I=1 TO 3
 412 FOR I=6 TO 9
 ***NESTED FOR-LOOP CONTROL VARIABLES THE SAME
 414 PRINT I;
 416 NEXT I
 418 GOTO 422
 420 NEXT I
 ***NEXT FOUND BUT NO FOR OPEN
 422 PRINT I;" SB 6 THRU 10"
 430 PRINT "10 NESTED FORS -- NB V IS STILL ACTIVE AT 286"
 432 FOR A=1 TO 1
 434 FOR B=2 TO 2
 436 FOR C=-3 TO -3
 438 FOR D=4 TO 4 STEP -1
 440 FOR E=5 TO 5 STEP-1
 ***SPACES MUST PRECEDE AND FOLLOW KEYWORD
 444 PRINT A;B; -C;D;E;
 446 FOR F=-6 TO -6 STEP -1
 448 FOR G=7 TO 7
 450 FOR H=8 TO 8
 452 FOR I=9 TO 9
 454 PRINT -F; G; H; I; " SB 1 THRU 9"
 456 NEXT I
 458 NEXT H
 460 NEXT G
 462 NEXT F
 464 NEXT E
 466 NEXT D
 468 NEXT C
 470 NEXT B
 472 NEXT A
 480 GOSUB 290
 498 PRINT "END FOR TESTS"
 499 GOTO 640
 500 REM SUBROUTINE 1
 502 PRINT  "X" ;
 504 RETURN
 600 REM RECURSIVE MULTIPLY SUBROUTINE : X1*X2
 605 DEF FNO=1
 610 PRINT X1;
 615 IF X1=FNO THEN 630
 618 LET X1=X1-FNO
 620 GOSUB 605
 622 LET F=F+X2
 624 RETURN
 630 LET F=X2
 632 RETURN
 640 PRINT "TEST RANDOM NUMBERS"
 641 PRINT RND,RND," SHOULD BE THE SAME 2 VALUES EVERY RUN"
 642 RANDOMIZE
 643 PRINT RND,RND," SHOULD BOTH CHANGE (ALMOST) EVERY RUN"
 644 RANDOMIZE
 645 PRINT RND,RND," SHOULD BOTH CHANGE (ALMOST) EVERY RUN"
 646 LET E=9
 647 LET A=9
 650 LET E$="EIGHTEEN CHAR STRI"
 652 LET N$=""
 654 LET F$=E$
 655 IF A<>E THEN 658
 656 LET G$="NG"
 658 PRINT F$;""; N$; G$; " SB EIGHTEEN CHAR STRING"
 670 PRINT "COMPARISON OF STRINGS"
 672 IF E$<>E$ THEN 674
 673 PRINT "A";
 674 IF N$<>"" THEN 676
 675 PRINT "B";
 676 IF "PIG"<>"PIG" THEN 678
 ***WARNING - NO VARIABLES IN RELATIONAL EXPRESSIONS
 677 PRINT "C";
 678 IF"" = " " THEN 680
 ***NO SPACE FOLLOWS KEYWORD
 ***WARNING - NO VARIABLES IN RELATIONAL EXPRESSIONS
 679 PRINT "D";
 680 IF "PIG"="PIT" THEN 682
 ***WARNING - NO VARIABLES IN RELATIONAL EXPRESSIONS
 681 PRINT "E";
 682 IF G$="EIGHTEEN CHAR PTRI" THEN 684
 683 PRINT "F";
 684 IF E$ > E$ THEN 686
 ***ILLEGAL STRING EXPRESSION
 685 PRINT "G";
 686 IF E$<E$THEN 688
 ***ILLEGAL STRING EXPRESSION
 ***SPACES MUST PRECEDE AND FOLLOW KEYWORD
 687 PRINT "H";
 688 IF"A">"B" THEN 690
 ***NO SPACE FOLLOWS KEYWORD
 ***ILLEGAL STRING EXPRESSION
 ***WARNING - NO VARIABLES IN RELATIONAL EXPRESSIONS
 689 PRINT "I";
 690 PRINT " SB ABCDEFGHI"
 691 PRINT "J";
 692 IF"A">="A:" THEN 694
 ***NO SPACE FOLLOWS KEYWORD
 ***ILLEGAL STRING EXPRESSION
 ***WARNING - NO VARIABLES IN RELATIONAL EXPRESSIONS
 693 PRINT "K";
 694 IF "A:"<="A" THEN 696
 ***ILLEGAL STRING EXPRESSION
 ***WARNING - NO VARIABLES IN RELATIONAL EXPRESSIONS
 695 PRINT "L";
 696 IF E$<="EIGHTEEN CHAR STRG" THEN 698
 ***ILLEGAL STRING EXPRESSION
 697 PRINT "M";
 698 IF":"<""THEN 700
 ***NO SPACE FOLLOWS KEYWORD
 ***ILLEGAL STRING EXPRESSION
 ***WARNING - NO VARIABLES IN RELATIONAL EXPRESSIONS
 ***SPACES MUST PRECEDE AND FOLLOW KEYWORD
 699 PRINT "N";
 700 IF "2"<"1" THEN 710
 ***ILLEGAL STRING EXPRESSION
 ***WARNING - NO VARIABLES IN RELATIONAL EXPRESSIONS
 701 PRINT "O";
 710IFE$=F$THEN712
 ***NO SPACE FOLLOWS KEYWORD
 ***SPACES MUST PRECEDE AND FOLLOW KEYWORD
 711 PRINT " STRING ERROR  1"
 712 IF  ""  ="" THEN 714
 ***WARNING - NO VARIABLES IN RELATIONAL EXPRESSIONS
 713 PRINT " STRING ERROR  2"
 714 IF E$<>"EIGHTEEN CHAR STRG" THEN 716
 715 PRINT " STRING ERROR  3"
 716 IF E$ >"EIGHTEEN CHAR STRG" THEN 718
 ***ILLEGAL STRING EXPRESSION
 717 PRINT " STRING ERROR  4"
 718 IF":">  "" THEN 720
 ***NO SPACE FOLLOWS KEYWORD
 ***ILLEGAL STRING EXPRESSION
 ***WARNING - NO VARIABLES IN RELATIONAL EXPRESSIONS
 719 PRINT " STRING ERROR  5"
 720 IF "EIGHTEEN CHAR STRG" <E$ THEN 722
 ***ILLEGAL STRING EXPRESSION
 721 PRINT " STRING ERROR  6"
 722 IF N$ < " " THEN 724
 ***ILLEGAL STRING EXPRESSION
 723 PRINT " STRING ERROR  7"
 724 IF E$>=E$ THEN 726
 ***ILLEGAL STRING EXPRESSION
 725 PRINT " STRING ERROR   8"
 726 IF E$<=E$ THEN 728
 ***ILLEGAL STRING EXPRESSION
 727 PRINT " STRING ERROR   9"
 728 IF "012345678901"<="012345678911" THEN 730
 ***ILLEGAL STRING EXPRESSION
 ***WARNING - NO VARIABLES IN RELATIONAL EXPRESSIONS
 729 PRINT " STRING ERROR 10"
 730 IF ":">="" THEN 732
 ***ILLEGAL STRING EXPRESSION
 ***WARNING - NO VARIABLES IN RELATIONAL EXPRESSIONS
 731 PRINT " STRING ERROR 11"
 732 PRINT "P SB JKLMNOP"
 750 PRINT "EXPRESSION EVALUATION TESTS"
 752 PRINT 3-1-1; 1+2*.5; 15-4*3; 56/7/2; " SB 1 THRU 4"
 754 DEF FNU(X)=X+1*1
 756 LET U(3,4)=2
 758 PRINT (2+8)/2; (((4))+(-(-(2))));FNU(4+6/3); U(6/3+1,3*2-2)^4-8;
 760 PRINT " SB 5 THRU 8"
 762 PRINT3-(2+U(-5+4*2,6 +   FNU(3^2+6)-18) ) +6; " SB 5", 2^3^4; " SB
 ***NON-BLANK CHARACTERS OCCUR AFTER POSITION 72
 ***SPACES MUST PRECEDE AND FOLLOW KEYWORD
 ***NO MATCHING CLOSING QUOTE IN STRING
 764 PRINT-2^2,-(+1+2^2);-2*9^.5;-56/2^3; " SB -4 THRU -7"
 ***SPACES MUST PRECEDE AND FOLLOW KEYWORD
 766 PRINT(1E38+1E-38)-(1E38-1E-38)+5.7; " SB 5.7"
 ***SPACES MUST PRECEDE AND FOLLOW KEYWORD
 768 IF 1+2*3^4=168-125/5^2 THEN 770
 ***WARNING - NO VARIABLES IN RELATIONAL EXPRESSIONS
 769 PRINT "EXPRESSION EVALUATION ERROR"
 770 PRINT 6*10/4; 2^2*4; 3/3*17; 1*3*1*3*2*1/1; " SB 15 THRU 18"
 772 PRINT-3^2; -4*2,-8+1; -(+(-(+(-5))))-1; " SB -9 THRU -6"
 ***SPACES MUST PRECEDE AND FOLLOW KEYWORD
 800 PRINT "ARRAY TESTS"
 802 DIM A(1),B(1,2),C(3,4), D(5,11)
 804 LET A(0)=1
 806 LET A(1)=2
 808 LET B(0,0)=3
 810 LET B(A(0),2)=4
 812 LET X(0)=5
 814 LET X(10)=6
 816 LET Y(0,0)=7
 818 LET Y(10,10)=Y(0,0)+A(0)
 820 PRINT A(0);A(A(A(0))-1);B(0,0);B(1,3-1);  " SB 1 THRU 4"
 822 PRINT X(0); X(10); Y(2*0,0);Y(10,10);  " SB 5 THRU 8"
 824 DEF FNC=M(N+M+N(0,A(0)-1)-2)
 826 LET N(0,0)=10
 828 LET M(10)=9
 829 LET M=5
 830 LET N=-M+2
 832 LET M(0)=N(0,0)-2
 834 PRINT FNC;M(.49); M(10.49)-2;
 836 LET X(9)=10.4
 838 PRINT M(X(M(X( FNC+1-1)-.3))+1-SGN(N(0,0)))^.5*2;  " SB 9 THRU 6"
 850 FOR I=1 TO 3
 852 FOR J=0 TO 4
 854 GOTO 856
 856 DIM Q(3,4)
 858 DEF FNF=2
 859 LET Q(I,J)=FNF^(I-1)
 860 IF I=1 THEN 862
 861 LET Q(I,J)=Q(I,J)+Q(I-1,J)
 862 FOR K=1 TO J
 864 LET Q(I,K)=Q(I,K)+Q(I,K-1)
 866 NEXT K
 868 NEXT J
 870 NEXT I
 872 PRINT 2^Q(1,2); Q(1,4); Q(2,4); Q(3,4);  " SB 8192,23,156,642 "
 874 LET X(FNC+X(3*3)-INT(11.9)-RND*.4)= 11
 876 PRINT X(N(0,0)^A(0)-2)^A(1);  " SB 121"
 900 PRINT "TEST DATA AND INPUT"
 902 GOTO 904
 904 DATA 3 , "EIGHTEEN CHAR STRI", EIGHTEEN CHAR STRI
 906 LET E$="EIGHTEEN CHAR STRI"
 908 READ X
 910 GO SUB 1050
 918DATA""
 ***NO SPACE FOLLOWING STATEMENT NUMBER
 ***NO SPACE FOLLOWS KEYWORD
 926 DATA 3.0,4.0 ,  .05E2  ,600E-02,.007E+3,8.00000001
 928 FOR I=1 TO 6
 930 READ J
 932 PRINT J;
 934 NEXT I
 936 PRINT " SB 3 THRU 8"
 938DATA                                      -4,+5,-60E-1,2,10,4
 ***NO SPACE FOLLOWING STATEMENT NUMBER
 940 READ A,B,C
 942 PRINT A,-B,C," SB -4 THRU -6"
 944 LET I=3
 946 READ I,X(I),X ( X ( I ) )
 948 PRINT I,X(2),X(10)," SB 2,10,4"
 950 READ I,J,I,J,X(2),X(J)
 952 DATA 20,200,1,2
 953 DATA 2000,.30
 954 PRINT I,J,X(2)*10, " IS 1 THRU 3"
 956 DEF FNH(I)=X(I+1)-14
 958 LET X(6)=20
 960 READ  J,X(FNH(J))
 962 DATA 5,10
 964 PRINT J,X(6)," SB 5,10"
 966 DATA"   ",  .  ,",..."
 ***NO SPACE FOLLOWS KEYWORD
 968 READ A$,B$,C$
 970 PRINT "+.+" ; A$ ; "+";B$;"+";C$; " SB +.+   +.+,..."
 972 DATA AZ09* ):$  ,  =<>-(..+E;/.
 ***STATEMENT CONTAINS NON-STANDARD CHARACTER
 ***NON-STANDARD CHARACTER IN UNQUOTED STRING
 ***NON-STANDARD CHARACTER IN UNQUOTED STRING
 ***NON-STANDARD CHARACTER IN UNQUOTED STRING
 ***NON-STANDARD CHARACTER IN UNQUOTED STRING
 ***NON-STANDARD CHARACTER IN UNQUOTED STRING
 ***NON-STANDARD CHARACTER IN UNQUOTED STRING
 ***NON-STANDARD CHARACTER IN UNQUOTED STRING
 ***NON-STANDARD CHARACTER IN UNQUOTED STRING
 ***NON-STANDARD CHARACTER IN UNQUOTED STRING
 ***NON-STANDARD CHARACTER IN UNQUOTED STRING
 974 DATA"AZ09* ):$" , "=<>-(..+E;/."
 ***STATEMENT CONTAINS NON-STANDARD CHARACTER
 ***NO SPACE FOLLOWS KEYWORD
 976 READ  A$,B$,Y$,Z$
 978 PRINT A$;B$;Y$;Z$
 979 PRINT " SB AZ09* ):$=<>-(..+E;/.  (REPEATED TWICE)"
 ***STATEMENT CONTAINS NON-STANDARD CHARACTER
 980 RESTORE
 982 READ Y
 984 PRINT X,Y," SB 3,3"
 985 GOSUB 1050
 986 FOR I=1 TO 20
 988 RESTORE
 990 NEXT I
 992 FOR J=1 TO 9
 994 READ C$
 996 NEXT J
 998 PRINT C$," SB .007E+3"
 1000 GO TO 1100
 1050 REM SUBROUTINE TO CHECK STRING INPUT
 1052  READ F$,G$
 1053 READ N$
 1054 GO TO 1058
 1056 INPUT F$,G$
 1057 INPUT N$
 1058 IF F$<>G$ THEN 1066
 1060 IF F$=E$ THEN 1068
 1066 PRINT " DATA ERROR 1 WITH:";F$,G$
 1068 IF N$="" THEN 1072
 1070 PRINT " DATA ERROR 2 WITH:";N$
 1072 LET F$="RUBBISH1"
 1074 LET G$="RUBBISH2"
 1076 LET N$="RUBBISH3"
 1078 RETURN
 1100 PRINT "NOW REPEAT USING INPUT FOR READ"
 1108 INPUT X0
 1110 GOSUB 1056
 1128 INPUT J1,J2,J3,J4,J5,J6
 1130 PRINT J1,J2,J3
 1134 PRINT J4,J5,J6
 1136 PRINT " IS 3 THRU 8"
 1140 INPUT A,B,C
 1142 PRINT A,-B,C," IS -4 THRU -6"
 1146 INPUT  I,X(I),X(X(I))
 1148 PRINT I,X(2),X(10)," IS 2,10,4"
 1150 INPUT I,J0,I,J0,R(2),R(J0)
 1154 PRINT I,J0,R(2)*10, " IS 1 THRU 3"
 1158 LET X(6)=20
 1160 INPUT J0,X(FNH(J0))
 1164 PRINT J0,X(6)," IS 5,10"
 1166 LET C$="1234567890123456"
 1168 INPUT A$,B$,C$
 1170PRINT "+.+" ; A$ ; "+";B$;"+";C$; " SB +.+   +.+,..."
 ***NO SPACE FOLLOWING STATEMENT NUMBER
 1176 INPUT A$,B$
 1177 INPUT P$,Q$
 1178 PRINT A$ ; B$;P$;Q$
 1179PRINT " SB AZ09* ):$=<>-(..+E;/.  (REPEATED TWICE)"
 ***STATEMENT CONTAINS NON-STANDARD CHARACTER
 ***NO SPACE FOLLOWING STATEMENT NUMBER
 1184 PRINT X0,X,Y," IS 3,3,3"
 1190 REM NOW INTERMIX READ WITH INPUT
 1192 RESTORE
 1194 READ X
 1196 INPUT X0
 1198 READ F$
 1200 INPUT S$,T$
 1201 INPUT G$
 1202 READ G$,N$
 1204 GOSUB 1058
 1206 PRINT X,X0,S$,T$," IS 3 THRU 6"
  5000 REM TEST SPACING ERRORS
 ***ONE OR MORE SPACES PRECEEDING STATEMENT NUMBER
 5001 DEF FN L=1
 ***SPACES NOT PERMITTED IN VARIABLE NAME
 5002 DEF F ND=1
 ***SPACES NOT PERMITTED IN VARIABLE NAME
 5003 RANDOMIZ E
 ***SPACES IN KEYWORD
 5004 PRINT A $
 ***SPACES NOT PERMITTED IN NUMBER/VARIABLE/FUNCTION NAME
 5005 LET A 1=3
 5006 PRINT SI N(X)
 ***SPACES NOT PERMITTED IN NUMBER/VARIABLE/FUNCTION NAME
 5007 DEF FNJ=RN D
 ***SPACES NOT PERMITTED IN NUMBER/VARIABLE/FUNCTION NAME
 5008 G O TO 5009
 ***SPACES IN KEYWORD
 5009 IF A> =3 THEN 5010
 ***SPACES NOT ALLOWED WITHIN MULTICHARACTER RELATIONAL SYMBOL
 5010 IF S< > S THEN 5011
 ***SPACES NOT ALLOWED WITHIN MULTICHARACTER RELATIONAL SYMBOL
 5011 FOR A1=1 TO 3 STE P 6
 ***SPACES NOT ALLOWED WITHIN KEYWORD
 5013 NEXT A 1
 ***SPACES NOT PERMITTED IN VARIABLE NAME
 5014 PRINT FN J
 ***SPACES NOT PERMITTED IN NUMBER/VARIABLE/FUNCTION NAME
 5015 PRINT 23 45
 ***SPACES NOT PERMITTED IN NUMBER/VARIABLE/FUNCTION NAME
 5016 PRINT 2. 1
 ***SPACES NOT PERMITTED IN NUMBER/VARIABLE/FUNCTION NAME
 5017 PRINT 5.6E 9
 ***SPACES NOT PERMITTED IN NUMBER/VARIABLE/FUNCTION NAME
 5018 PRINT 1.2E- 9
 ***SPACES NOT PERMITTED IN NUMBER/VARIABLE/FUNCTION NAME
 31000 STOP
 ***STATEMENT NUMBER EXCEEDS MAXIMUM ALLOWED
 31001 PRINT "ERROR IN STOP"
 ***STATEMENT NUMBER EXCEEDS MAXIMUM ALLOWED
 31999 END
 ***STATEMENT NUMBER EXCEEDS MAXIMUM ALLOWED
 ***ARRAY AND SIMPLE NUMERIC NAME CLASHES
 A
 B
 C
 D
 M
 N
 Q
 R
 U
 V
 X
 Y
 *** ILLEGAL JUMPS INTO FOR BLOCKS-CHECKS ABANDONED
    498  STATEMENTS PROCESSED
    152  ERROR MESSAGES OUTPUT
                 LINE NUMBER CROSS REFERENCE TABLE
                 ---------------------------------
          6    -          18
          8    -           6
         12    -          15
         14    -           9
         17    -          12
         24 *  -          20
         30    -          21
         63    -          61
         78    -          72      74
         85    -          82
         86    -          85
         87    -          85
         88    -          87
         89    -          87      88
         90    -          88
        103    -         101
        105    -         103
        107    -         105
        109    -         107
        111    -         109
        113    -         111
        115    -         113
        117 *  -         115
        123    -         121
        125    -         123
        127    -         125
        129    -         127
        131    -         129
        133    -         131
        135    -         133
        139    -         135
        200    -         139
        210    -         204
        280    -         276
        290 *  -         480
        294    -         291
        300    -         288
        306    -         322
        314    -         310
        320    -         304
        330    -         302
        350    -         318
        378    -         382
        422    -         418
        500 *  -         202     210
        600 *  -         218
        605    -         620
        630    -         615
        640    -         499
        658    -         655
        674    -         672
        676    -         674
        678    -         676
        680    -         678
        682    -         680
        684    -         682
        686    -         684
        688    -         686
        690    -         688
        694    -         692
        696    -         694
        698    -         696
        700    -         698
        710    -         700
        712    -         710
        714    -         712
        716    -         714
        718    -         716
        720    -         718
        722    -         720
        724    -         722
        726    -         724
        728    -         726
        730    -         728
        732    -         730
        770    -         768
        856    -         854
        862    -         860
        904    -         902
       1050 *  -         910     985
       1056    -        1110
       1058    -        1054    1204
       1066    -        1058
       1068    -        1060
       1072    -        1068
       1100    -        1000
       5009    -        5008
       5010    -        5009
       5011    -        5010
            VARIABLES AND FUNCTION CROSS REFERENCE TABLE
            --------------------------------------------


 SIMPLE VARIABLES
    A          -           5      17      18     151     254     258
                         262     266     270     274     278     432
                         444     472     647     655     940     942
                        1140    1142    5009
    A0         -         151
    A1         -         151    5005    5011    5013
    A2         -         151
    A3         -         151
    A4         -         151
    A5         -         151
    A6         -         151
    A7         -         151
    A8         -         151
    A9         -         151
    B          -         152     434     444     470     940     942
                        1140    1142
    B0         -         186
    B1         -         152
    B2         -         152
    B3         -         152
    B4         -         152
    B5         -         152
    B6         -         152
    B7         -         152
    B8         -         152
    B9         -         152
    C          -         153     436     444     468     940     942
                        1140    1142
    C0         -         186
    C1         -         153
    C2         -         153
    C3         -         153
    C4         -         153
    C5         -         153
    C6         -         153
    C7         -         153
    C8         -         153
    C9         -         153
    D          -         154     438     444     466
    D0         -         154
    D1         -         154
    D2         -         154
    D3         -         154
    D4         -         154
    D5         -         154
    D6         -         154
    D7         -         154
    D8         -         154
    D9         -         154
    E          -         155     252     254     261     440     444
                         464     646     655
    E0         -         186
    E1         -         155
    E2         -         155
    E3         -         155
    E4         -         155
    E5         -         155
    E6         -         155
    E7         -         155
    E8         -         155
    E9         -         155
    F          -         156     222     446     454     462     622
                         630
    F0         -         186
    F1         -         156
    F2         -         156
    F3         -         156
    F4         -         156
    F5         -         156
    F6         -         156
    F7         -         156
    F8         -         156
    F9         -         156
    G          -         157     448     454     460
    G0         -         186
    G1         -         157
    G2         -         157
    G3         -         157
    G4         -         157
    G5         -         157
    G6         -         157
    G7         -         157
    G8         -         157
    G9         -         157
    H          -         158     450     454     458
    H0         -         186
    H1         -         158
    H2         -         158
    H3         -         158
    H4         -         158
    H5         -         158
    H6         -         158
    H7         -         158
    H8         -         158
    H9         -         158
    I          -         159     242     244     246     300     306
                         314     320     330     350     354     356
                         360     368     370     372     378     384
                         386     390     392     396     399     400
                         410     412     414     416     422     452
                         454     456     850     859     860     861
                         864     870     928     934     944     946
                         948     950     954     956     986     990
                        1146    1148    1150    1154
    I0         -         186
    I1         -         159
    I2         -         159
    I3         -         159
    I4         -         159
    I5         -         159
    I6         -         159
    I7         -         159
    I8         -         159
    I9         -         159
    J          -         160     308     312     852     859     861
                         862     868     930     932     950     954
                         960     964     992     996
    J0         -         186    1150    1154    1160    1164
    J1         -         160    1128    1130
    J2         -         160    1128    1130
    J3         -         160    1128    1130
    J4         -         160    1128    1134
    J5         -         160    1128    1134
    J6         -         160    1128    1134
    J7         -         160
    J8         -         160
    J9         -         160
    K          -         186     362     364     366     862     864
                         866
    K0         -         186
    K1         -         161
    K2         -         161
    K3         -         161
    K4         -         161
    K5         -         161
    K6         -         161
    K7         -         161
    K8         -         161
    K9         -         161
    L          -         162
    L0         -         186
    L1         -         162
    L2         -         162
    L3         -         162
    L4         -         162
    L5         -         162
    L6         -         162
    L7         -         162
    L8         -         162
    L9         -         162
    M          -         164     824     829     830
    M0         -         187
    M1         -         164
    M2         -         164
    M3         -         164
    M4         -         164
    M5         -         164
    M6         -         164
    M7         -         164
    M8         -         164
    M9         -         164
    N          -         163     824     830
    N0         -         187
    N1         -         163
    N2         -         163
    N3         -         163
    N4         -         163
    N5         -         163
    N6         -         163
    N7         -         163
    N8         -         163
    N9         -         163
    O          -         165
    O0         -         187
    O1         -         165
    O2         -         165
    O3         -         165
    O4         -         165
    O5         -         165
    O6         -         165
    O7         -         165
    O8         -         165
    O9         -         165
    P          -         166     268     270     272     274     276
                         376     380     382     386     388     390
                         394     396
    P0         -         187
    P1         -         166
    P2         -         166
    P3         -         166
    P4         -         166
    P5         -         166
    P6         -         166
    P7         -         166
    P8         -         166
    P9         -         166
    Q          -         167     389     390     398
    Q0         -         187
    Q1         -         167
    Q2         -         167
    Q3         -         167
    Q4         -         167
    Q5         -         167
    Q6         -         167
    Q7         -         167
    Q8         -         167
    Q9         -         167
    R          -         185
    R0         -         185
    R1         -         185
    R2         -         185
    R3         -         185
    R4         -         185
    R5         -         185
    R6         -         185
    R7         -         185
    R8         -         185
    R9         -         185
    S          -         168    5010
    S0         -         187
    S1         -         168
    S2         -         168
    S3         -         168
    S4         -         168
    S5         -         168
    S6         -         168
    S7         -         168
    S8         -         168
    S9         -         168
    T          -         169
    T0         -         169
    T1         -         169
    T2         -         169
    T3         -         169
    T4         -         169
    T5         -         169
    T6         -         169
    T7         -         169
    T8         -         169
    T9         -         169
    U          -         170
    U0         -         170
    U1         -         170
    U2         -         170
    U3         -         170
    U4         -         170
    U5         -         170
    U6         -         170
    U7         -         170
    U8         -         170
    U9         -         170
    V          -         171     286     288     291     292     294
                         296
    V0         -         171
    V1         -         171
    V2         -         171
    V3         -         171
    V4         -         171
    V5         -         171
    V6         -         171
    V7         -         171
    V8         -         171
    V9         -         171
    W          -         172
    W0         -         172
    W1         -         172
    W2         -         172
    W3         -         172
    W4         -         172
    W5         -         172
    W6         -         172
    W7         -         172
    W8         -         172
    W9         -         172
    X          -          52      53      63      65      68      71
                         174     754     908     984    1184    1194
                        1206    5006
    X0         -         174    1108    1184    1196    1206
    X1         -         174     214     306     320     610     615
                         618
    X2         -         174     216     306     330     622     630
    X3         -          81      85      88     174
    X4         -         174
    X5         -         174
    X6         -         174
    X7         -         174
    X8         -         174
    X9         -         174
    Y          -         175     982     984    1184
    Y0         -         187
    Y1         -         175
    Y2         -         175
    Y3         -         175
    Y4         -         175
    Y5         -         175
    Y6         -         175
    Y7         -         175
    Y8         -         175
    Y9         -         175
    Z          -         176
    Z0         -         176
    Z1         -         176
    Z2         -         176
    Z3         -         176
    Z4         -         176
    Z5         -         176
    Z6         -         176
    Z7         -         176
    Z8         -         176
    Z9         -          64     176     256     258     260     266


 STRING VARIABLES
    A$         -         180     968     970     976     978    1168
                        1170    1176    1178    5004
    B$         -         180     968     970     976     978    1168
                        1170    1176    1178
    C$         -         180     968     970     994     998    1166
                        1168    1170
    D$         -         180
    E$         -         180     650     654     672     684     686
                         696     710     714     716     720     724
                         726     906    1060
    F$         -         180     654     658     710    1052    1056
                        1058    1060    1066    1072    1198
    G$         -         180     656     658     682    1052    1056
                        1058    1066    1074    1201    1202
    H$         -         181
    I$         -         181
    J$         -         181
    K$         -         181
    L$         -         181
    M$         -         181
    N$         -         181     652     658     674     722    1053
                        1057    1068    1070    1076    1202
    O$         -         182
    P$         -         182    1177    1178
    Q$         -         182    1177    1178
    R$         -         182
    S$         -         182    1200    1206
    T$         -         182    1200    1206
    U$         -         187
    V$         -         184
    W$         -         184
    X$         -         184
    Y$         -         184     976     978
    Z$         -         184     976     978


 NUMERIC ARRAYS
    A          -         802     804     806     810     818     820
                         824     876
    B          -         802     808     810     820
    C          -         802
    D          -         802
    M          -         824     828     832     834     838
    N          -         824     826     832     838     876
    Q          -         856     859     861     864     872
    R          -        1150    1154
    U          -         756     758     762
    V          -          14
    X          -         812     814     822     836     838     874
                         876     946     948     950     954     956
                         958     960     964    1146    1148    1158
                        1160    1164
    Y          -         816     818     822


 USER DEFINED FUNCTIONS
    FNA        -          62      64      70      72
    FNB        -          63      64      65      70      71
    FNC        -         824     834     838     874
    FND        -        5002
    FNF        -         858     859
    FNH        -         956     960    1160
    FNJ        -        5007    5014
    FNK        -          65      74      75
    FNL        -        5001
    FNO        -         605     615     618
    FNU        -         754     758     762
    FNV        -           8
    FNY        -         255     256     306     368
    FNZ        -          64      71


 STANDARD FUNCTIONS
    INT        -         874
    RND        -          87     641     643     645     874    5007
    SGN        -          87     838
    SIN        -        5006


 TAB FUNCTION
    TAB        -          42      51
                STATEMENT TYPE CROSS REFERENCE TABLE
                ------------------------------------
    DATA       -         904     918     926     938     952     953
                         962     966     972     974
    DEF        -           8      62      63      64      65     255
                         605     754     824     858     956    5001
                        5002    5007
    DIM        -          14     802     856
    END        -       31999
    FOR        -         242     254     256     270     286     300
                         308     350     356     362     368     378
                         390     410     412     432     434     436
                         438     440     446     448     450     452
                         850     852     862     928     986     992
                        5011
    GOSUB      -          20     202     204     210     218     302
                         480     620     910     985    1110    1204
    GOTO       -           6       9      12      15      21      61
                         139     304     310     318     322     418
                         499     854     902    1000    1054    5008
    IF         -          18      72      74     101     103     105
                         107     109     111     113     115     121
                         123     125     127     129     131     133
                         135     276     288     291     382     615
                         655     672     674     676     678     680
                         682     684     686     688     692     694
                         696     698     700     710     712     714
                         716     718     720     722     724     726
                         728     730     768     860    1058    1060
                        1068    5009    5010
    INPUT      -        1056    1057    1108    1128    1140    1146
                        1150    1160    1168    1176    1177    1196
                        1200    1201
    LET        -           5      17      52      68      81     214
                         216     252     261     268     272     320
                         330     376     380     388     389     394
                         396     398     618     622     630     646
                         647     650     652     654     656     756
                         804     806     808     810     812     814
                         816     818     826     828     829     830
                         832     836     859     861     864     874
                         906     944     958    1072    1074    1076
                        1158    1166    5005
    NEXT       -         246     260     262     278     294     312
                         314     354     360     366     372     384
                         399     416     420     456     458     460
                         462     464     466     468     470     472
                         866     868     870     934     990     996
                        5013
    ON         -          82      85      87      88
    PRINT      -           4       7      30      32      33      34
                          35      36      37      38      39      41
                          42      43      44      45      46      47
                          48      49      50      51      53      54
                          55      60      70      71      73      75
                          78      83      86      89      90     102
                         104     106     108     110     112     114
                         116     120     122     124     126     128
                         130     132     134     136     151     152
                         153     154     155     156     157     158
                         159     160     161     162     163     164
                         165     166     167     168     169     170
                         171     172     174     175     176     180
                         181     182     184     185     186     187
                         200     212     220     222     240     244
                         248     258     264     266     274     280
                         292     296     306     316     352     358
                         364     370     374     386     392     400
                         414     422     430     444     454     498
                         502     610     640     641     643     645
                         658     670     673     675     677     679
                         681     683     685     687     689     690
                         691     693     695     697     699     701
                         711     713     715     717     719     721
                         723     725     727     729     731     732
                         750     752     758     760     762     764
                         766     769     770     772     800     820
                         822     834     838     872     876     900
                         932     936     942     948     954     964
                         970     978     979     984     998    1066
                        1070    1100    1130    1134    1136    1142
                        1148    1154    1164    1170    1178    1179
                        1184    1206    5004    5006    5014    5015
                        5016    5017    5018   31001
    RANDOMIZE  -         642     644    5003
    READ       -         908     930     940     946     950     960
                         968     976     982     994    1052    1053
                        1194    1198    1202
    REM        -           1       2      24      40     100     117
                         150     206     290     500     600    1050
                        1190    5000
    RESTORE    -         980     988    1192
    RETURN     -          25     298     332     504     624     632
                        1078
    STOP       -       31000
FILE CONTAINING ALL THE CHARACTERS USED IN PBASIC

THE UPPER CASE ALPHABET "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
THE NUMERALS ZERO TO NINE "0123456789"
PLUS ASCII 2/11 "+"
MINUS ASCII 2/13 "-"
CLOSE ASCII 2/9 ")"
EQUALS ASCII 3/13 "="
PERIOD ASCII 2/14 "."
OPEN ASCII 2/8 "("
ASTERISK ASCII 2/10 "*"
SLANT ASCII 2/15 "/"
SPACE ASCII 2/0 " "
LESS THAN ASCII 3/12 "<"
GREATER THAN ASCII 3/14 ">"
CIRCUMFLEX ASCII 5/14 "^"
QUOTE ASCII 2/2 """
EXCLAMATION POINT ASCII 2/1 "]"
NUMBER SIGN ASCII 2/3 "#"
DOLLAR ASCII 2/4 "$"
PERCENT ASCII 2/5 "%"
AMPERSAND ASCII 2/6 "&"
APOSTROPHE ASCII 2/7 "'"
COLON ASCII 3/10 ":"
SEMI COLON ASCII 3/11 ";"
QUESTION MARK ASCII 3/15 "?"
UNDERLINE ASCII 5/15 "_"
COMMA ASCII 2/12 ","

