C       CONTINUOUS SYSTEM MODELING PROGRAM
C
C  25 JUL 75 (PDH.14) CHANGE 'INCRMT' CALLING SEQUENCE AGAIN; REQUEST
C                     MUCH 'DISPLY' CORE
C  18 JUL 75 (PDH.13) CHANGE 'INCRMT' CALLING SEQUENCE; EXPAND TIME AXIS
C  16 JUL 75 (PDH.12) IMPLEMENT PHASE-PLANE PLOTTING
C   9 JUL 75 (PDH.11) CHANGE SUBROUTINE 'INCRMT'
C   2 JUL 75 (PDH.10) DO SOME TIDYING UP TO ALLOW CHAINING, IF DESIRED
C  13 JUN 74 (JAF) COMPUTED GOTO IN 'CSM11' MUST HAVE SIMPLE VARIABLE
C  12 JUN 74 (PDH) ADD BLOCK DATA SUBPROGRAMS
C   9 NOV 73 (PDH) CHANGE 'TEXT' CHARACTER SIZE TO 2
C  24 OCT 73 (PDH) ALLOW CURVE PLOTTING WITHOUT LABELS & BORDER
C  15 OCT 73 (JAF) ADD 'AUXILLIARY FUNCTION' (IE RESOLVER)
C  10 OCT 73 (JAF) ADD 'COPY' FACILITY TO OUTPUT
C   5 OCT 73 (JAF) ADD GOOD DISPLAY PLOTTING
C  14 NOV 72 - CHANGE LINE PRINTER PLOT ACCURACY (CSM8)
C  22 JUN 72
C
C  MODIFIED BY J. FIELD & P. HENDERSON TO RUN IN 'WATRAN'
C  AT THE UNIVERSITY OF WATERLOO
C
C
C       CSMP MAIN PROGRAM
C
C       CARNEGIE-MELLON UNIVERSITY
C       HYBRID COMPUTATION LABORATORY
C       JANUARY, 1969
C
        INTEGER TEST1,TEST2,TEST3,TEST4,TEST7
      INTEGER DKT,DK,PR,TTO,TTI,CD,LP,PP,PD
        LOGICAL RSAC
        COMMON REALS(395),INTS(547)
      COMMON /ASSIGN/DKT,DK,PR,TTO,TTI,CD,LP,PP,PD
      COMMON /EXTRA2/TY(30)
      COMMON /LIMITS/FILL(4)
      COMMON /CSMPJF/IFILL(6)
      EQUIVALENCE (INTS(380),KEY1),(INTS(381),KEY2),(INTS(382),KEY3)
      EQUIVALENCE (INTS(383),KEY4),(INTS(387),KEY8)
      EQUIVALENCE (INTS(525),TEST1),(INTS(526),TEST2)
      EQUIVALENCE (INTS(527),TEST3),(INTS(528),TEST4)
        EQUIVALENCE (INTS(531),TEST7)
C
C       INITIALIZATION SUBROUTINE
      CALL CLEAR (.TRUE.)
      CALL APDE8
        CALL CSM0
C
C       GET NEW SENSE SWITCH SETTINGS
10      CALL CSM12
        IF (KEY8.EQ.2) GO TO 100
C
C       INTERROGATE BLOCK OUTPUTS
        TEST2=TTI
        CALL CSM13
        GO TO 10
C
C       CONFIGURATION SECTION
C       PROGRAM WILL NOT BRANCH BEYOND THE CONFIGURATION  SECTION
C           UNTIL A SUCCESSFUL SORT TEST (TEST1=2) IS ACHIEVED
100     IF (TEST1.EQ.2.AND.KEY1.EQ.2) GO TO 200
C       GET CONFIGURATION SPECIFICATIONS
        TEST1=2
110     CALL CSM1
C       PREPARE FOR SORT
        CALL CSM2
        IF (TEST1.EQ.1) GO TO 110
C       SORT
        CALL CSM3
        IF (TEST1.EQ.1) GO TO 110
C
C       SET-UP SECTION
C
C       PARAMETERS AND INITIAL CONDITIONS
200     IF (TEST3.EQ.2.AND.KEY2.EQ.2) GO TO 300
        CALL CSM4
C
C       FUNCTION GENERATORS
300     IF (TEST4.EQ.1) GO TO 400
        IF (TEST3.EQ.2.AND.KEY3.EQ.2) GO TO 400
        CALL CSM5
C
C       INDICATE COMPLETION OF MODEL SPECIFICATIONS
400     TEST2=TTI
        TEST3=2
        IF (RSAC(0)) GO TO 10
C
C       OUTPUT OUTDATED MODEL
        IF (RSAC(11).OR.RSAC(12)) GO TO 410
        GO TO 500
410     CALL CSM6
        IF (RSAC(0)) GO TO 10
C
C       INTEGRATION SPECIFICATIONS
500     IF (TEST7.EQ.2.AND.KEY4.EQ.2) GO TO 600
        CALL CSM7
        IF (RSAC(0)) GO TO 10
C
C       OUTPUT SPECIFICATIONS
600     CALL CSM8A
        IF (RSAC(0)) GO TO 10
C
C       COMPUTE SECTION
        CALL CSM10
        GO TO 10
C
        END
CSM0
        SUBROUTINE CSM0
C       INITIALIZATION
        INTEGER TEST(9)
      INTEGER DKT,DK,PR,TTO,TTI,CD,LP,PP,PD
      COMMON /ASSIGN/DKT,DK,PR,TTO,TTI,CD,LP,PP,PD
      COMMON /LIMITS/XMIN,XMAX,YMIN,YMAX
        COMMON REALS(395),INTS(547)
        EQUIVALENCE (INTS(525),TEST(1))
      CALL DISPLY (0,20000,I)
      WRITE (PD,10)
        WRITE(TTO,10)
10      FORMAT(1H0,10X,34HCONTINUOUS SYSTEM MODELING PROGRAM//)
      XMIN = 0
      XMAX = 1023
      YMIN = 0
      YMAX = 1023
        DO 20 I=1,547
20      INTS(I)=0
        DO 30 I=1,395
30      REALS(I)=0.0
        DO 50 I=1,8
50      TEST(I)=1
        RETURN
        END
CSM1
        SUBROUTINE CSM1
C       CONFIGURATION SPECIFICATIONS
        INTEGER TEST2,TEST9
      INTEGER DKT,DK,PR,TTO,TTI,CD,LP,PP,PD
        LOGICAL RSAC
        DIMENSION MTRX(75,5)
        COMMON REALS(395),INTS(547)
        COMMON/EXTRA2/TY(30)
      COMMON /ASSIGN/DKT,DK,PR,TTO,TTI,CD,LP,PP,PD
        EQUIVALENCE (INTS(1),MTRX(1,1))
        EQUIVALENCE (INTS(526),TEST2)
        EQUIVALENCE (INTS(533),TEST9)
C       GET INPUT UNIT TEST2
        CALL INUNIT
      WRITE (PD,10)
10      FORMAT(/10X,27HCONFIGURATION SPECIFICATION/)
        IF (TEST2.EQ.4) GO TO 40
C       NON-TTY INPUT
      WRITE (PD,30)
30      FORMAT(40H BLOCK  TYPE   INPUT 1  INPUT 2  INPUT 3)
        GO TO 60
C       TTY INPUT
40    WRITE (PD,50)
50      FORMAT(39H BLOCK, TYPE, INPUT 1, INPUT 2, INPUT 3)
C       INPUT STATEMENTS
60      I=KINPUT(0,IERR)
        IF (IERR) 400,70,340
70      IF (I) 340,400,80
80      IF (I.GT.75) GO TO 340
        J=0
        K=0
        L=0
        ATYPE=FINPUT(1,IERR)
C       SEARCH THROUGH PROGRAM LIBRARY FOR BLOCK TYPE ATYPE
        DO 90 M=1,30
        IF (ATYPE.EQ.TY(M)) GO TO 120
90      CONTINUE
C       TYPE IS NOT IN THE LIBRARY
100   WRITE (PD,110) I
110     FORMAT(28H ILLEGAL BLOCK TYPE IN BLOCK,I3)
        GO TO 360
120     IF (IERR) 180,130,320
130     J=KINPUT(0,IERR)
        IF (IERR) 180,140,320
140     IF (IABS(J).GT.76) GO TO 320
        K=KINPUT(0,IERR)
        IF (IERR) 180,150,320
150     IF (IABS(K).GT.76) GO TO 320
        L=KINPUT(0,IERR)
        IF (IERR) 180,160,320
160     IF (IABS(L).GT.76) GO TO 320
        IF (FINPUT(-1,IERR).NE.0.0) GO TO 320
C       LEGAL BLOCK, TYPE, AND INPUTS
180     IF (M.LE.10) GO TO (200,200,100,200,100,200,200,200,220,190),M
        N=M-10
        IF (N.LE.10) GO TO (190,200,200,200,200,200,210,220,210,200),N
        N=N-10
        GO TO (200,190,220,210,210,210,250,200,210,250),N
190     IF (J.GT.0) GO TO 320
200     IF (K.GT.0) GO TO 320
210     IF (L.GT.0) GO TO 320
220     IF (J.LT.0) GO TO 320
230     IF (K.LT.0) GO TO 320
240     IF (L.LT.0) GO TO 320
C       LEGAL STATEMENTS - STORE THE CONFIGURATION
250     MTRX(I,2)=J
        MTRX(I,3)=K
        MTRX(I,4)=L
C        IF (TEST2.EQ.TTI.OR.RSAC(10)) GO TO 290
C       TELEPRINTER RECORD
        K=4
        DO 260 L=1,3
        IF (MTRX(I,K).NE.0) GO TO 270
260     K=K-1
      WRITE (PD,280) I,ATYPE
        GO TO 290
270     WRITE(PD,280) I,ATYPE,(MTRX(I,L),L=2,K)
280     FORMAT(3X,I2,5X,A1,3(6X,I3))
C       CHECK FOR BLOCK DELETION
290     IF (MTRX(I,1).NE.0) WRITE(PD,300) I
300     FORMAT(15H PREVIOUS BLOCK,I3,8H DELETED)
        MTRX(I,1)=M
        IF (M.NE.30) GO TO 60
        MTRX(I,1)=0
        MTRX(I,5)=0
        GO TO 60
C       ILLEGAL STATEMENT
320     WRITE(PD,330) I
330     FORMAT(15H ERROR IN BLOCK,I3)
        GO TO 360
C       ILLEGAL BLOCK NUMBER
340     WRITE(PD,350) I
350     FORMAT(17H BLOCK NUMBER OF ,I7,11H IS ILLEGAL)
360     TEST9=-1
        GO TO 60
C       END OF CONFINURATION SPECIFICATION
400     TEST9=0
        RETURN
        END
CSM2
        SUBROUTINE CSM2
C       PREPARE FOR SORT
        INTEGER TEST(9),DELAY(25),ORDER(76)
      INTEGER DKT,DK,PR,TTO,TTI,CD,LP,PP,PD
        DIMENSION MTRX(75,5),INTG(25)
        COMMON REALS(395),INTS(547)
      COMMON /ASSIGN/DKT,DK,PR,TTO,TTI,CD,LP,PP,PD
        EQUIVALENCE (INTS(1),MTRX(1,1))
        EQUIVALENCE (INTS(396),INTG(1))
        EQUIVALENCE (INTS(424),DELAY(1))
        EQUIVALENCE (INTS(449),ORDER(1))
        EQUIVALENCE (INTS(525),TEST(1))
        EQUIVALENCE (INTS(540),NCON)
        EQUIVALENCE (INTS(541),NOD)
        EQUIVALENCE (INTS(542),NEQ)
        EQUIVALENCE (INTS(543),NFG)
C       RESET ERROR INDICATOR AND COUNTERS
        IERR=2
        NOD=0
        NEQ=0
        IFG=0
        NCON=2
        ORDER(1)=76
C
C       TEST FOR SELECTED ELEMENTS
        DO 80 I=1,75
        ITYPE=IABS(MTRX(I,1))
        IF (ITYPE.EQ.0) GO TO 80
        MTRX(I,1)=ITYPE
        IF (ITYPE.NE.21) GO TO 10
C       UNIT DELAY
        NOD=NOD+1
        DELAY(NOD)=I
        GO TO 40
10      IF (ITYPE.NE.9) GO TO 20
C       INTEGRATOR
        NEQ=NEQ+1
        INTG(NEQ)=I
        MTRX(I,5)=NEQ
        GO TO 40
20      IF (ITYPE.NE.11) GO TO 30
C       CONSTANT
        ORDER(NCON)=I
        NCON=NCON+1
        GO TO 50
C       FUNCTION GENERATOR
30      IF (ITYPE.EQ.6) IFG=IFG+1
C       NEGATE ELEMENT IDENTIFIER UNTIL AFTER SORTING
40      MTRX(I,1)=-ITYPE
50      DO 70 J=2,4
        LTEST=IABS(MTRX(I,J))
      IF (LTEST.LE.0) GO TO 70
        IF (LTEST.GT.75.OR.MTRX(LTEST,1).NE.0) GO TO 70
        WRITE(PD,60) LTEST,I
60      FORMAT(6H BLOCK,I3,16H, INPUT TO BLOCK,I3,9H, MISSING)
        IERR=1
70      CONTINUE
80      CONTINUE
C
C       TEST ON PROPER NUMBER OF ELEMENTS
        IF (NEQ.GT.0) GO TO 100
        WRITE(PD,90)
90      FORMAT(31H AT LEAST 1 INTEGRATOR REQUIRED)
        IERR=1
        GO TO 120
100     IF (NEQ.LE.25) GO TO 120
        WRITE(PD,110)
110     FORMAT(48H THE MAXIMUM OF 25 INTEGRATORS HAS BEEN EXCEEDED)
        IERR=1
120     IF (NOD.LE.25) GO TO 140
        WRITE(PD,130)
130     FORMAT(48H THE MAXIMUM OF 25 UNIT DELAYS HAS BEEN EXCEEDED)
        IERR=1
140     IF (IFG.LE.3) GO TO 170
        WRITE(PD,150)
150   FORMAT(55H THE MAXIMUM OF 3 FUNCTION GENERATORS HAS BEEN EXCEEDED)
C       UNSUCCESSFUL PRE-SORT
160     TEST(1)=1
        RETURN
170     IF (IERR.EQ.1) GO TO 160
        IF (IFG.GT.0) GO TO 180
C       NO FUNCTION GENERATORS
        TEST(4)=1
        NFG=0
        GO TO 190
C       SOME FUNCTION GENERATORS
180     TEST(4)=2
        IF (IFG.GT.NFG) TEST(3)=1
C       TEST3=1 TO SIGNAL ADDITION OF FUNCTION GENERATOR BLOCK(S)
        NFG=IFG
C       SUCCESSFUL PRE-SORT
190     TEST(1)=2
        RETURN
        END
CSM3
        SUBROUTINE CSM3
C       SORT
        INTEGER TEST1,DELAY(25),ORDER(76)
      INTEGER DKT,DK,PR,TTO,TTI,CD,LP,PP,PD
        DIMENSION MTRX(75,5),INTG(25)
        COMMON REALS(395),INTS(547)
      COMMON /ASSIGN/DKT,DK,PR,TTO,TTI,CD,LP,PP,PD
        EQUIVALENCE (INTS(1),MTRX(1,1)),(INTS(396),INTG(1))
        EQUIVALENCE (INTS(424),DELAY(1)),(INTS(449),ORDER(1))
        EQUIVALENCE (INTS(525),TEST1),(INTS(534),NLIST)
        EQUIVALENCE (INTS(540),NCON),(INTS(541),NOD),(INTS(542),NEQ)
C       RESET ERROR INDICATOR
        IERR=2
        DO 10 N=NCON,76
10      ORDER(N)=0
C
C       SORT OPERATION
        NLIST=NCON-1
20      DO 80 I=1,75
        IF (MTRX(I,1).GE.0) GO TO 80
        DO 70 J=2,4
        LTEST=IABS(MTRX(I,J))
        IF (LTEST.EQ.0) GO TO 70
        IF (NOD.EQ.0) GO TO 40
        DO 30 K=1,NOD
        IF (LTEST.EQ.DELAY(K)) GO TO 70
30      CONTINUE
40      DO 50 K=1,NEQ
        IF (LTEST.EQ.INTG(K)) GO TO 70
50      CONTINUE
        DO 60 K=1,NLIST
        IF (LTEST.EQ.ORDER(K)) GO TO 70
60      CONTINUE
        GO TO 80
70      CONTINUE
        GO TO 130
80      CONTINUE
C
C       SORT TEST
        DO 90 I=1,75
        IF (MTRX(I,1).LT.0) GO TO 110
90      CONTINUE
        IF (IERR.EQ.1) GO TO 100
C       SUCCESSFUL SORT
        TEST1=2
        RETURN
C       UNSUCCESSFUL SORT
100     TEST1=1
        RETURN
C       SORT FAILURE - SET ERROR INDICATOR, TYPE ERROR MESSAGE,
C          AND PUT BLOCK IN THE SORT ORDER LIST TO DETERMINE
C          WHETHER THE REST OF THE CONFIGURATION WOULD BE OK
110     IERR=1
        WRITE(PD,120) I
120     FORMAT(22H SORT FAILURE AT BLOCK,I3)
130     MTRX(I,1)=-MTRX(I,1)
        NLIST=NLIST+1
        ORDER (NLIST)=I
        GO TO 20
        END
CSM4
        SUBROUTINE CSM4
C       INITIAL CONDITIONS AND PARAMETERS
        INTEGER TEST2,TEST9
      INTEGER DKT,DK,PR,TTO,TTI,CD,LP,PP,PD
        DIMENSION MTRX1(75),PAR(75,3)
        COMMON REALS(395),INTS(547)
      COMMON /ASSIGN/DKT,DK,PR,TTO,TTI,CD,LP,PP,PD
        EQUIVALENCE (INTS(1),MTRX1(1))
        EQUIVALENCE (INTS(526),TEST2),(INTS(533),TEST9)
        EQUIVALENCE (REALS(81),PAR(1,1))
C       GET INPUT UNIT TEST2
        CALL INUNIT
        WRITE(PD,10)
10      FORMAT(/10X,29HINITIAL CONDITIONS/PARAMETERS/)
C       NON-TTY INPUT
        WRITE(PD,30)
30      FORMAT(6H BLOCK,3X,7HIC/PAR1,8X,4HPAR2,10X,4HPAR3)
C       INPUT STATEMENTS
60      I=KINPUT(0,IERR)
        IF (IERR) 400,70,300
70      IF (I) 300,400,80
80      IF (I.GT.75) GO TO 300
        P3=0.0
        P2=0.0
        P1=FINPUT(0,IERR)
        IF (IERR) 150,90,280
90      P2=FINPUT(0,IERR)
        IF (IERR) 150,100,280
100     P3=FINPUT(0,IERR)
        IF (IERR) 150,110,280
110     IF (FINPUT(-1,IERR).NE.0.0) GO TO 280
C       LEGAL BLOCK NUMBERS AND PARAMETERS
150     ITYPE=MTRX1(I)
        IF (ITYPE) 240,160,180
160     WRITE(PD,170)
170     FORMAT(41H NO CORRESPONDING CONFIGURATION STATEMENT)
        GO TO 240
C       TEST PARAMETERS
180     IF (ITYPE.GT.10) GO TO 190
        GO TO (205,210,280,230,280,230,220,210,240,210),ITYPE
190     IF (ITYPE.GT.20) GO TO 200
        ITYPE=ITYPE-10
        GO TO (220,230,210,210,220,210,210,210,220,220),ITYPE
200     ITYPE=ITYPE-20
        GO TO (220,220,240,210,230,220,210,210,210),ITYPE
C
205   IF (P1>4!P1<1) GO TO 280
      GO TO 220
210     IF (P1.NE.0.) GO TO 280
220     IF (P2.NE.0.) GO TO 280
230     IF (P3.NE.0.) GO TO 280
240     PAR(I,1)=P1
        PAR(I,2)=P2
        PAR(I,3)=P3
C   TELEPRINTER RECORD
        K=3
        DO 250 L=1,3
        IF (PAR(I,K).NE.0.0) GO TO 260
250     K=K-1
        WRITE(PD,270) I
        GO TO 60
260     WRITE(PD,270) I,(PAR(I,L),L=1,K)
270     FORMAT(3X,I2,1X,3(1X,G13.6))
        GO TO 60
280     WRITE(PD,290)
290     FORMAT(33H IMPROPER PARAMETER SPECIFICATION)
        GO TO 320
300     WRITE(PD,310)
310     FORMAT(21H INVALID BLOCK NUMBER)
320     TEST9=-1
        GO TO 60
C       END OF INITIAL CONDITION AND PARAMETER SPECIFICATION
400     TEST9=0
        RETURN
        END
CSM5
        SUBROUTINE CSM5
C       FUNCTION GENERATOR SPECIFICATIONS
        INTEGER TEST2,TEST9
      INTEGER DKT,DK,PR,TTO,TTI,CD,LP,PP,PD
        LOGICAL RSAC
        DIMENSION MTRX(75,5),NOFG(3),F(3,11),C(0/76),PAR1(75),PAR2(75)
        COMMON REALS(395),INTS(547)
      COMMON /ASSIGN/DKT,DK,PR,TTO,TTI,CD,LP,PP,PD
        EQUIVALENCE (INTS(1),MTRX(1,1))
        EQUIVALENCE (INTS(421),NOFG(1))
        EQUIVALENCE (INTS(526),TEST2),(INTS(533),TEST9)
        EQUIVALENCE (REALS(2),C(1)),(REALS(81),PAR1(1))
        EQUIVALENCE (REALS(156),PAR2(1)),(REALS(306),F(1,1))
C       GET INPUT UNIT TEST2
        CALL INUNIT
        WRITE(PD,10)
10      FORMAT(/10X,33HFUNCTION GENERATOR SPECIFICATIONS/)
C       GET BLOCK NUMBER
20      I=KINPUT(0,IERR)
        IF (IERR) 300,30,200
30      IF (I) 240,300,40
40      IF (I.GT.75.OR.MTRX(I,1).NE.6) GO TO 240
C       FIND SPOT FOR THE FUNCTION GENERATOR
        DO 50 M=1,3
        IF (I.EQ.NOFG(M)) GO TO 70
50      CONTINUE
        DO 60 M=1,3
        N=NOFG(M)
      IF (N.EQ.0) GO TO 70
        IF (MTRX(N,1).NE.6) GO TO 70
60      CONTINUE
        GO TO 240
70      N=1
C       GET INTERCEPTS
80      C(N)=FINPUT(0,IERR)
        IF (IERR) 80,90,200
90      N=N+1
        IF (N.LE.11) GO TO 80
        IF (FINPUT(-1,IERR).NE.0.0) GO TO 220
C       STORE FUNCTION GENERATOR
        MTRX(I,5)=M
        NOFG(M)=I
        DO 100 N=1,11
100     F(M,N)=C(N)
C        IF (TEST2.NE.TTI.AND..NOT.RSAC(10)) WRITE(PD,110) I,(C(N),N=1,11)
      WRITE (PD,110) I,(C(N),N=1,11)
C       TELEPRINTER RECORD
110     FORMAT(I3,9X,5(1X,G11.4)/6(1X,G11.4))
C       CHECK PAR1 AND PAR2
120     IF (PAR1(I).GT.PAR2(I)) GO TO 20
        WRITE(PD,130) I
130     FORMAT(44H SPECIFY LIMITS FOR FUNCTION GENERATOR BLOCK,I3)
140     WRITE(PD,150)
150     FORMAT(14H UPPER, LOWER=)
        PAR1(I)=FINPUT(0,IERR)
        IF (IERR.NE.0) GO TO 140
        PAR2(I)=FINPUT(0,IERR)
        IF (IERR) 120,160,140
160     IF (FINPUT(-1,IERR).NE.0.0) GO TO 140
        GO TO 120
C       ERROR SECTION
200     WRITE(PD,210)
210     FORMAT(13H SYNTAX ERROR)
        GO TO 260
220     WRITE(PD,230)
230     FORMAT(30H TOO MANY INTERCEPTS SPECIFIED)
        GO TO 260
240     WRITE(PD,250) I
250     FORMAT(6H BLOCK,I3,40H WAS NOT DEFINED AS A FUNCTION GENERATOR)
260     TEST9=-1
        GO TO 20
C       END OF FUNCTION GENERATOR SPECIFICATION
300     TEST9=0
        RETURN
        END
CSM6
        SUBROUTINE CSM6
C       OPTION TO OUTPUT UPDATED MODEL
        INTEGER OU,TEST4
      INTEGER DKT,DK,PR,TTO,TTI,CD,LP,PP,PD
        LOGICAL RSAC
        DIMENSION MTRX(75,5),NOFG(3),F(3,11),PAR(75,3)
        COMMON REALS(395),INTS(547)
      COMMON /ASSIGN/DKT,DK,PR,TTO,TTI,CD,LP,PP,PD
        COMMON/EXTRA2/TY(30)
        EQUIVALENCE (INTS(1),MTRX(1,1)),(INTS(421),NOFG(1))
        EQUIVALENCE (INTS(528),TEST4)
        EQUIVALENCE (REALS(81),PAR(1,1)),(REALS(306),F(1,1))
        IF (RSAC(11)) GO TO 20
C       LINE PRINTER/CARD PUNCH OUTPUT
        WRITE(LP,10)
10      FORMAT(1H1)
        OU=LP
        GO TO 40
C       PAPER TAPE OUTPUT
20      OU=PP
30      FORMAT(3H  $)
C       OUTPUT CONFIGURATION SPECIFICATIONS
40      DO 80 I=1,75
        J=MTRX(I,1)
        IF (J.LE.0) GO TO 80
        K=4
        DO 50 L=1,3
        IF (MTRX(I,K).NE.0) GO TO 60
50      K=K-1
        WRITE(OU,70) I,TY(J)
        GO TO 80
60      WRITE(OU,70) I,TY(J),(MTRX(I,L),L=2,K)
70      FORMAT(3X,I2,5X,A1,3(6X,I3))
80      CONTINUE
        WRITE(OU,30)
C       OUTPUT INITIAL CONDITIONS AND PARAMETERS
        DO 130 I=1,75
        J=MTRX(I,1)
        IF (J.LE.0) GO TO 130
        K=3
        DO 100 L=1,3
        IF (PAR(I,K).NE.0.0) GO TO 110
100     K=K-1
        GO TO 130
110     IF (J.EQ.20.OR.J.EQ.21.OR.J.EQ.26) K=1
C       THE PRECEDING STATEMENT DELETES TEMPORARY DELAY PARAMETERS
C          GENERATED BY T (TIME PULSE), U (UNIT DELAY), AND 
C          Z (ZERO ORDER HOLD) BLOCKS DURING EXECUTION (OF CSM11)
        WRITE(OU,120) I,(PAR(I,L),L=1,K)
120     FORMAT(3X,I2,1X,3(1X,G13.6))
130     CONTINUE
        WRITE(OU,30)
C       OUTPUT FUNCTION GENERATORS
        IF (TEST4.EQ.1) GO TO 170
        DO 160 I=1,3
        J=NOFG(I)
      IF (J.LE.0) GO TO 160
        IF (MTRX(J,1).NE.6) GO TO 160
C       IT IS CONFIRMED THAT THE BLOCK IS A FUNCTION GENERATOR
        WRITE(OU,140) J,(F(I,K),K=1,11)
140     FORMAT(I3,9X,5(1X,G11.4)/6(1X,G11.4))
160     CONTINUE
        WRITE(OU,30)
170     IF (OU.EQ.LP) WRITE(LP,180)
180     FORMAT(//1H1)
        RETURN
        END
CSM7
        SUBROUTINE CSM7
C       REQUEST TIMING INFORMATION
        INTEGER TEST7
      INTEGER DKT,DK,PR,TTO,TTI,CD,LP,PP,PD
        COMMON REALS(395),INTS(547)
      COMMON /ASSIGN/DKT,DK,PR,TTO,TTI,CD,LP,PP,PD
        EQUIVALENCE (INTS(531),TEST7)
        EQUIVALENCE (REALS(78),DT),(REALS(79),DTS2),(REALS(80),TTOT)
C
        WRITE(PD,10)
10      FORMAT(/10X,19HINTEGRATION CONTROL/)
        TEST7=2
C       TEST7=1 UNTIL FIRST TIME THROUGH CSM7
C       TEST7=2 AFTER FIRST TIME THROUGH CSM7
20      WRITE(PD,30)
30      FORMAT(22H INTEGRATION INTERVAL=)
        DT=FINPUT(0,IERR)
      WRITE (PD,31) DT
31    FORMAT (1XG13.6)
        IF (IERR.NE.0) GO TO 20
        IF (FINPUT(-1,IERR).NE.0.0) GO TO 20
        IF (DT.GT.0.0) GO TO 60
        WRITE(PD,50)
50      FORMAT(44H INTEGRATION INTERVAL MUST BE GREATER THAN 0)
        GO TO 20
60      DTS2=0.5*DT
70      WRITE(PD,80)
80      FORMAT(12H TOTAL TIME=)
        TTOT=FINPUT(0,IERR)
      WRITE (PD,31) TTOT
        IF (IERR.NE.0) GO TO 70
        IF (FINPUT(-1,IERR).NE.0.0) GO TO 70
        IF (TTOT.GT.DT) RETURN
        WRITE(PD,90)
90    FORMAT(53H TOTAL TIME MUST BE GREATER THAN INTEGRATION INTERVAL)
        GO TO 70
        END
CSM8
        SUBROUTINE CSM8
C       PRINT CONTROLLER
        INTEGER OU
      INTEGER DKT,DK,PR,TTO,TTI,CD,LP,PP,PD
      INTEGER TAG,SEQNCE
        REAL IPLOT(101)
        DIMENSION C(0/76)
        COMMON REALS(395),INTS(547)
      COMMON /ASSIGN/DKT,DK,PR,TTO,TTI,CD,LP,PP,PD
      COMMON /CSMPJF/TAG,SEQNCE,HMIN,HDEL
        EQUIVALENCE (INTS(386),KEY7),(INTS(388),KEY9)
      EQUIVALENCE (INTS(389),KEY10)
        EQUIVALENCE (INTS(535),K1),(INTS(536),K2)
        EQUIVALENCE (INTS(537),K3),(INTS(538),K4)
        EQUIVALENCE (INTS(539),NK)
        EQUIVALENCE (REALS(2),C(1)),(REALS(77),T),(REALS(80),TTOT)
        EQUIVALENCE (REALS(392),VDEL),(REALS(394),VMIN)
      EQUIVALENCE (DY,N)
        DATA FBLANK,FDASH,FI,FPLUS/1H ,1H-,1HI,1H+/
      IF (KEY10.EQ.1) GO TO 160
        IF (KEY7.EQ.1) GO TO 140
        IF (KEY9.EQ.1) GO TO 70
C       TELEPRINTER PLOTTING
        N=0.5+50.0*(C(K1)-VMIN)/VDEL
        IF (N.LE.0) GO TO 20
        IF (N.GT.49) N=49
C       DASHES TO LEFT OF PLOTTED POINT
        DO 10 I=2,N
10      IPLOT(I)=FDASH
        GO TO 30
20      N=0
C       INDICATE PLOTTED POINT BY PLUS SIGN
30      IPLOT(N+1)=FPLUS
        N=N+2
        IF (N.GT.50) GO TO 50
C       BLANKS TO RIGHT OF PLOTTED POINT
        DO 40 I=N,50
40      IPLOT(I)=FBLANK
C       INDICATE MARGINS BY LETTER I
50      IPLOT(1)=FI
        IPLOT(51)=FI
        WRITE(PD,60) T,C(K1),(IPLOT(I),I=1,51)
60      FORMAT(1H ,G10.3,G11.4,51A1)
        RETURN
C       LINE PRINTER PLOTTING
70      N=0.5+100.0*(C(K1)-VMIN)/VDEL
        IF (N.LE.0) GO TO 90
        IF (N.GT.99) N=99
C       DASHES TO LEFT OF PLOTTED POINT
        DO 80 I=2,N
80      IPLOT(I)=FDASH
        GO TO 100
90      N=0
C       INDICATE PLOTTED POINT BY PLUS SIGN
100     IPLOT(N+1)=FPLUS
        N=N+2
        IF (N.GT.100) GO TO 120
C       BLANKS TO RIGHT OF PLOTTED POINT
        DO 110 I=N,100
110     IPLOT(I)=FBLANK
C       INDICATE MARGINS BY LETTER I
120     IPLOT(1)=FI
        IPLOT(101)=FI
        WRITE(LP,130) T,C(K1),(IPLOT(I),I=1,101)
C       FOLLOWING FORMAT STATEMENT IS NOT VERY GOOD - SEE FORMAT 60
C130     FORMAT(1H ,G8.2,G9.2,1X,101A1)
C  EXPAND LINE WIDTH FOR GREATER NUMBER ACCURACY
130   FORMAT (1H ,G10.3,G11.4,1X101A1)
        RETURN
C       PRINT ONLY
140     OU=PD
        IF (KEY9.EQ.1) OU=LP
        IPLOT(1)=C(K1)
        IPLOT(2)=C(K2)
        IPLOT(3)=C(K3)
        IPLOT(4)=C(K4)
        WRITE(OU,150) T,(IPLOT(I),I=1,NK)
150     FORMAT(1H ,G11.5,4G13.6)
        RETURN
C
C  GENERATE PROPER X-Y PLOT ON DISPLAY
C
160   Y = 30.0 + 960.*(C(K1)-VMIN)/VDEL
      IF (NK > 1) GO TO 161
C
C  WE HAVE TIME ON THE X-AXIS
C
      X = 30.0 + 960.*T/TTOT
      GO TO 162
C
C  WE HAVE A PHASE-PLANE PLOT (BLOCK NUMBER ON X-AXIS)
C
161   X = 30.0 + 960.*(C(K2)-HMIN)/HDEL
162   CALL INCRMT (SEQNCE,TAG,X,Y,7)
      RETURN
      END
C.INCRMT
C
C  25 JUL 75 (PDH) ADD INTENSITY PARAMETER; CHANGE PARAMETER ORDER
C  18 JUL 75 (PDH) CHANGE TO CO-ORDINATE CALLS WITH 'LIMITS'
C  15 JUL 75 (PDH) MODIFY TO ALLOW USE AS A GENERALIZED SUBROUTINE
C   9 JUL 75 (PDH) MODIFICATION OF AN EARLIER PROGRAM BY J.A. FIELD
C
      SUBROUTINE INCRMT (SEQNCE,TAG,XC,YC,INTENS)
C
C  SUBROUTINE TO ALLOW PLOTTING ON THE DISPLAY IN INCREMENT MODE.
C  NOTE THAT COMMON AREA 'LIMITS' MUST BE PROPERLY SET UP
C
C  ARGUMENT DESCRIPTION:
C     XC, YC ARE THE CO-ORDINATES OF THE NEXT POINT TO BE PLOTTED.
C       IF SEQNCE = -1, A NEW LINE IS BEGUN AT (XC,YC).
C     TAG IS THE TAG NUMBER USED WHEN 'INCRMT' CALLS 'DISPLY'.
C       TAG IS INCREMENTED AFTER USE.
C     SEQNCE IS USED TO SPECIFY INITIALIZATION (<0), NORMAL CALL (0)
C       OR CLEANUP(>0),.  CLEANUP IMPLIES TRANSFER OF THE EXISTING
C       DISPLAY CONSTRUCTION TO 'DISPLY', AND RE-INITIALIZATION.
C       IN ALL CASES, 'SEQNCE' IS SET TO ZERO.
C
C
      INTEGER DX,DY,TAG,SEQNCE,BYTE,LINE,X,Y,SHOW(100),
     * ESCAPE/-65536/,BRIGHT/65536/,PARAM/12360/,POINTY/73728/,
     * POINTX/50176/,SHIFT(4)/4096,256,16,1/,STEP(-1/1)/3,0,2/
      INTEGER XNEW,YNEW,XOLD,YOLD
      COMMON /LIMITS/XMIN,XMAX,YMIN,YMAX
C
      XBGIN = X
      YBGIN = Y
      XOLD  = X
      YOLD  = Y
      AX = AMIN1(XMAX,AMAX1(XMIN,XC))
      AY = AMIN1(YMAX,AMAX1(YMIN,YC))
      AX = 0.5 + 1023.*(AX-XMIN)/ABS(XMAX-XMIN)
      AY = 0.5 + 1023.*(AY-YMIN)/ABS(YMAX-YMIN)
      DX = IFIX(AX) - X
      DY = IFIX(AY) - Y
      LIMIT = MAX0 (IABS(DX),IABS(DY))
      IF (SEQNCE) 2,4,1
C
C  'SEQNCE' > 0. TRANSFER THE EXISTING 'SHOW' ARRAY TO 'DISPLY',
C  THEN PREPARE TO RE-INITIALIZE THE 'SHOW' ARRAY.
C
   1  CALL DRAW (SHOW,1,0)
      SHOW(LINE+1) = ESCAPE
      CALL DISPLY (6,TAG,SHOW,1,LINE+3)
      SEQNCE = -1
      GO TO 3
C
C  'SEQNCE' < 0. THIS IS AN INITIALIZING CALL.  INTERPRET 'DX' &
C  'DY' AS ABSOLUTE COORDINATES, AND PREPARE TO INITIALIZE 'SHOW'.
C
   2  XBGIN = AX
      YBGIN = AY
   3  LIMIT = 1
      BYTE  = 4
      LINE  = 98
C
C  'SEQNCE' = 0 TRANSFERS DIRECTLY HERE.  IF 'SEQNCE' = 0 WHEN
C  'DX' & 'DY' ARE ZERO, RETURN IMMEDIATELY.
C
   4  IF (LIMIT .EQ. 0) RETURN
      XSTEP = FLOAT(DX)/LIMIT
      YSTEP = FLOAT(DY)/LIMIT
      DO 11 J=1,LIMIT
      XNEW  = XBGIN + FLOAT(J)*XSTEP + 0.5
      YNEW  = YBGIN + FLOAT(J)*YSTEP + 0.5
      IDX = XNEW - XOLD
      IDY = YNEW - YOLD
      X = X + IDX
      Y = Y + IDY
C
C  CHECK TO SEE IF WE HAVE FILLED THE 'SHOW' ARRAY
C
      IF (BYTE < 4) GO TO 9
      IF (LINE < 98) GO TO 8
      IF (SEQNCE .NE. -1) GO TO 5
C
C  'XBGIN' & 'YBGIN' CONTAIN THE DESIRED SCREEN CO-ORDINATES.
C
      X = XBGIN
      Y = YBGIN
      SEQNCE = 0
      GO TO 6
   5  CALL DRAW (SHOW,1,0)
      CALL DISPLY (6,TAG,SHOW,1,100)
   6  TAG = TAG + 1
      SHOW(98) = ESCAPE
      DO 7 K=97,5,-1
      SHOW(K) = BRIGHT
   7  CONTINUE
      SHOW(2) = PARAM + MIN0(7,MAX0(0,INTENS))
      SHOW(3) = POINTY + Y
      SHOW(4) = POINTX + X
      CALL DRAW (SHOW,1,100)
      LINE = 5
      BYTE = 0
      GO TO 10
C
   8  BYTE = 0
      LINE = LINE + 1
   9  BYTE = BYTE + 1
      SHOW(LINE) = SHOW(LINE) + SHIFT(BYTE)*(4*STEP(IDX)+STEP(IDY))
  10  XOLD = XNEW
      YOLD = YNEW
  11  CONTINUE
      X = AX
      Y = AY
      RETURN
      END
CSM8A
        SUBROUTINE CSM8A
C       PRINT SPECIFICATIONS
        INTEGER PRINT(4),TEST8,OU,COL
      REAL FT/'T'/
      INTEGER DKT,DK,PR,TTO,TTI,CD,LP,PP,PD
      INTEGER TAG,SEQNCE
      INTEGER BOX(10)/0,12415,73758,32798,65656,96256,
     * 65784,-2048,0,0/
      CHARACTER*25 TLINE(1)/'(''0'',14X,''TIME'',9X,G13.4)'/
      CHARACTER*30 BLINE(1)/'(A1,G10.4,6X,''BLOCK'',I3,G15.4)'/
        COMMON REALS(395),INTS(547)
      COMMON /ASSIGN/DKT,DK,PR,TTO,TTI,CD,LP,PP,PD
      COMMON /CSMPJF/TAG,SEQNCE,HMIN,HDEL
        EQUIVALENCE (INTS(383),KEY4),(INTS(384),KEY5),(INTS(385),KEY6)
        EQUIVALENCE (INTS(386),KEY7),(INTS(388),KEY9),(INTS(389),KEY10)
      EQUIVALENCE (INTS(532),TEST8),(INTS(535),PRINT(1)),(INTS(539),NK)
      EQUIVALENCE (INTS(533),COL)
        EQUIVALENCE (REALS(78),DT),(REALS(391),TSAMP),(REALS(80),TTOT)
        EQUIVALENCE (REALS(392),VDEL),(REALS(394),VMIN)
C
      IF (KEY10.EQ.1.AND.KEY4.EQ.1) GO TO 55
        IF (TEST8.EQ.2.AND.KEY5.EQ.2.AND.KEY6.EQ.2) GO TO 270
      IF (KEY10.EQ.1) GO TO 55
        WRITE(PD,10)
10      FORMAT(/10X,14HOUTPUT CONTROL/)
        IF (TEST8.EQ.2.AND.KEY5.EQ.2) GO TO 60
C       PRINT INTERVAL SPECIFICATION
20      WRITE(PD,30)
30      FORMAT(16H PRINT INTERVAL=)
        TSAMP=FINPUT(0,IERR)
      WRITE (PD,31) TSAMP
31    FORMAT (1X2G13.6)
        IF (IERR.NE.0) GO TO 20
        IF (FINPUT(-1,IERR).NE.0.0) GO TO 20
        IF (TSAMP.GE.DT) GO TO 60
        WRITE(PD,50)
50    FORMAT(' PRINT INTERVAL CANNOT BE LESS THAN INTEGRATION INTERVAL')
        GO TO 20
55    TSAMP = DT
C
60      IF (TEST8.EQ.2.AND.KEY6.EQ.2) GO TO 270
C       PRINT VARIABLES SPECIFICATION
      IF (KEY10.EQ.1) GO TO 69
        IF (KEY7.EQ.1) GO TO 160
C       PRINT AND PLOT
69      NK=1
70      WRITE(PD,80)
80      FORMAT(14H Y-AXIS BLOCK=)
        PRINT(1)=KINPUT(0,IERR)
      WRITE (PD,81) PRINT(1)
81    FORMAT (I6)
        IF (IERR.NE.0) GO TO 70
        IF (FINPUT(-1,IERR).NE.0.0) GO TO 70
        IF (PRINT(1).GT.0.AND.PRINT(1).LT.76) GO TO 110
        WRITE(PD,100)
100     FORMAT(18H NOT A LEGAL BLOCK)
        GO TO 70
110     WRITE(PD,120)
120     FORMAT(25H MINIMUM, MAXIMUM VALUES=)
        VMIN=FINPUT(0,IERR)
        IF (IERR.NE.0) GO TO 110
        VMAX=FINPUT(0,IERR)
        IF (IERR.NE.0) GO TO 110
      WRITE (PD,31) VMIN,VMAX
        IF (FINPUT(-1,IERR).NE.0.0) GO TO 110
        VDEL=VMAX-VMIN
        IF (VDEL.GT.0.0) GO TO 280
        WRITE(PD,150)
150     FORMAT(36H MAXIMUM CANNOT BE LESS THAN MINIMUM)
        GO TO 110
C       PRINT ONLY
160     WRITE(PD,170)
170     FORMAT(36H BLOCK A, BLOCK B, BLOCK C, BLOCK D=)
        NK=0
        DO 190 I=1,4
        PRINT(I)=KINPUT(0,IERR)
        IF (IERR) 200,180,160
180     IF (PRINT(I).LT.1.OR.PRINT(I).GT.75) GO TO 220
        NK=NK+1
190     CONTINUE
        IF (FINPUT(-1,IERR).NE.0.0) GO TO 160
200     IF (NK) 160,160,250
220     WRITE(PD,100)
        GO TO 160
C       PRINT ONLY HEADING
250     OU=PD
        IF (KEY9.EQ.1) OU=LP
        WRITE(OU,260) (PRINT(I),I=1,NK)
260     FORMAT(///1H1/5X,5HTIME ,4(5X,5HBLOCK,I3))
        GO TO 320
C
270   IF (KEY10.EQ.1) GO TO 330
        IF (KEY7.EQ.1) GO TO 250
C       PRINT AND PLOT HEADING
280   IF (KEY10.EQ.1) GO TO 330
        IF (KEY9.EQ.1) GO TO 300
        WRITE(PD,290) PRINT(1),VMIN,VMAX
290     FORMAT(1H1,1X,4HTIME,5X,5HBLOCK,I3,2X,G13.6,26X,G13.6)
        GO TO 320
300     WRITE(LP,310) PRINT(1),VMIN,VMAX
C       FOLLOWING FORMAT STATEMENT IS NOT VERY GOOD - SEE FORMAT 290
C310     FORMAT(1H1/3X,12HTIME   BLOCK,I3,1X,G11.4,81X,G11.4)
C  132 COLUMN PRINTER ALLOWS GREATER ACCURACY
310   FORMAT (1H1/3X,12HTIME   BLOCK,I3,5XG13.6,76XG13.6)
C       TEST8=1 UNTIL FIRST TIME THROUGH CSM8A
C       TEST8=2 AFTER FIRST TIME THROUGH CSM8A
320     TEST8=2
        RETURN
C
C  INITIALIZATION FOR DISPLAY
C
330   IF (TEST8.NE.2 .OR. KEY6.EQ.1) GO TO 332
      IF (NK > 1) GO TO 335
      GO TO 337
C
331   WRITE (PD,100)
332   WRITE (PD,*) 'X-AXIS BLOCK OR TIME (T):'
C
C  ASSUME RESPONSE WILL BE NUMERICAL I.E. A BLOCK NUMBER
C
      PRINT(2) = KINPUT (0,IERR)
      IF (IERR) 332,333,336
333   WRITE (PD,*) PRINT(2)
      IF (FINPUT(-1,IERR) .NE. 0.0) GO TO 332
      IF (PRINT(2) < 1 .OR. PRINT(2) > 75) GO TO 331
334   WRITE (PD,120)
      HMIN = FINPUT (0,IERR)
      IF (IERR .NE. 0) GO TO 334
      HMAX = FINPUT (0,IERR)
      IF (IERR. NE. 0) GO TO 334
      WRITE (PD,31) HMIN,HMAX
      IF (FINPUT (-1,IERR) .NE. 0.0) GO TO 334
      HDEL = HMAX - HMIN
      IF (HDEL > 0.0) GO TO 335
      WRITE (PD,150)
      GO TO 334
C
335   NK = 2
      CALL DISPLY (8)
      CALL TEXT (2,1,30,0,7,2,BLINE,' ',HMIN,PRINT(2),HMAX)
      GO TO 338
C
C  RESPONSE WAS ALPHABETIC.  RE-READ REQUEST TO CONFIRM 'T'
C
336   COL = 1
      IF (FINPUT (1,IERR) .NE. FT) GO TO 332
      IF (FINPUT(-1,IERR) .NE. 0.0) GO TO 332
337   CALL DISPLY (8)
      CALL TEXT (2,1,30,0,7,2,TLINE,TTOT)
C
338   CALL TEXT (2,2,24,40,7,2,BLINE,'^',VMIN,PRINT(1),VMAX)
      CALL DISPLY (6,3,BOX,1,10)
      TAG = 4
      SEQNCE = -1
      GO TO 320
      END
CSM10
        SUBROUTINE CSM10
C       CONTROLS THE COMPUTATION AND OUTPUT
        INTEGER TEST5,ORDER(76)
      INTEGER DKT,DK,PR,TTO,TTI,CD,LP,PP,PD
        LOGICAL RSAC
        DIMENSION INTG(25),C(0/76),PAR1(75),Y(25),DYDT(25),YK(25)
        COMMON REALS(395),INTS(547)
      COMMON /ASSIGN/DKT,DK,PR,TTO,TTI,CD,LP,PP,PD
        EQUIVALENCE (INTS(388),KEY9)
        EQUIVALENCE (INTS(396),INTG(1)),(INTS(449),ORDER(1))
        EQUIVALENCE (INTS(529),TEST5),(INTS(534),NLIST)
        EQUIVALENCE (INTS(542),NEQ),(INTS(546),IR)
        EQUIVALENCE (REALS(2),C(1)),(REALS(77),T),(REALS(78),DT)
        EQUIVALENCE (REALS(79),DTS2),(REALS(80),TTOT)
        EQUIVALENCE (REALS(81),PAR1(1)),(REALS(341),Y(1))
        EQUIVALENCE (REALS(366),DYDT(1)),(REALS(391),TSAMP)
C       NORMAL SETUP
        DO 10 NEXT=2,NLIST
        I=ORDER(NEXT)
10      C(I)=PAR1(I)
        T=0.0
        TZERO=0.0
        DO 20 NEXT=1,NEQ
        I=INTG(NEXT)
20      Y(NEXT)=C(I)
        IR=7243
        EPSLN=DTS2/(TSAMP*2.0)
        TEST5=1
        N=1
        NN=T/TSAMP+1.0
        CALL CSM11
C
C       START EXECUTION
30      IF (RSAC(0)) GO TO 110
40      GO TO (50,80,100,110,110,110),TEST5
50      CALL CSM8
C       FIRST HALF-STEP
60      TEST5=2
        DO 70 NEXT=1,NEQ
        YK(NEXT)=Y(NEXT)
70      Y(NEXT)=Y(NEXT)+DTS2*DYDT(NEXT)
        AXX=N
        TNEXT=AXX*DT+TZERO
        T=TNEXT-DTS2
        CALL CSM11
        GO TO 40
C       SECOND HALF STEP
80      TEST5=3
        DO 90 NEXT=1,NEQ
90      Y(NEXT)=YK(NEXT)+DT*DYDT(NEXT)
        T=TNEXT
        N=N+1
        CALL CSM11
        GO TO 30
C       TIME TO PRINT
100     M=T/TSAMP+EPSLN
        IF (M.LT.NN) GO TO 120
110     CALL CSM8
        NN=M+1
C       IS RUN FINISHED
120     IF (TEST5.GT.3) GO TO 150
130     IF (RSAC(0)) GO TO 140
        IF (T-TTOT+DTS2) 60,150,150
140     TEST5=5
150     IF (KEY9.EQ.1) WRITE(LP,160)
160     FORMAT(//1H1)
        RETURN
        END
CSM11
        SUBROUTINE CSM11
C       DOES THE COMPUTATION REQUIRED
C          TO EVALUATE THE DERIVATIVE VECTOR
C          FOR ONE-HALF TIME STEP
        INTEGER TEST5,ORDER(76)
        LOGICAL RSAC
        DIMENSION INTG(25),C(0/76),F(3,11),Y(25),DYDT(25)
        DIMENSION MTRX1(75),MTRX2(75),MTRX3(75),MTRX4(75),MTRX5(75)
        DIMENSION PAR1(75),PAR2(75),PAR3(75)
        COMMON REALS(395),INTS(547)
        EQUIVALENCE (INTS(1),MTRX1(1)),(INTS(76),MTRX2(1))
        EQUIVALENCE (INTS(151),MTRX3(1)),(INTS(226),MTRX4(1))
        EQUIVALENCE (INTS(301),MTRX5(1))
        EQUIVALENCE (INTS(396),INTG(1)),(INTS(449),ORDER(1))
        EQUIVALENCE (INTS(529),TEST5),(INTS(534),NLIST)
        EQUIVALENCE (INTS(540),NCON),(INTS(542),NEQ),(INTS(546),IR)
        EQUIVALENCE (REALS(2),C(1)),(REALS(78),DT),(REALS(79),DTS2)
        EQUIVALENCE (REALS(81),PAR1(1)),(REALS(156),PAR2(1))
        EQUIVALENCE (REALS(231),PAR3(1)),(REALS(306),F(1,1))
        EQUIVALENCE (REALS(341),Y(1)),(REALS(366),DYDT(1))
C
        DO 10 I=1,NEQ
        J=INTG(I)
10      C(J)=Y(I)
        NEXT=NCON
20      I=ORDER(NEXT)
        P1=PAR1(I)
        P2=PAR2(I)
        P3=PAR3(I)
        J=MTRX2(I)
        K=MTRX3(I)
        L=MTRX4(I)
        IF (J.GE.0.AND.J.LE.76) CJ=C(J)
        IF (K.GE.0.AND.K.LE.76) CK=C(K)
        IF (L.GE.0.AND.L.LE.76) CL=C(L)
        M=MTRX1(I)
        IF (M.LE.10) GO TO (21,30,750,40,750,80,110,120,130,140),M
        M=M-10
        IF (M.LE.10) GO TO (650,150,180,190,210,220,230,240,270,290),M
        M=M-10
        GO TO (340,350,360,370,380,390,410,510,520),M
C
C  A - AUXILLIARY FUNCTION
C
  21  IFIXP1 = P1
      GO TO (22,23,24,25),IFIXP1
22    CI = SIN (CJ)
      GO TO 600
23    CI = COS (CJ)
      GO TO 600
24    CI = ALOG (CJ)
      GO TO 600
25    CI = EXP (CJ)
      GO TO 600
C
C       B - BANG-BANG
30      CI=SIGN(1.0,CJ)
        GO TO 600
C       D - DEAD SPACE
40      IF (CJ) 50,200,60
50      DIFF=CJ-P2
        IF (DIFF) 70,200,200
60      DIFF=CJ-P1
        IF (DIFF) 200,200,70
70      CI=DIFF
        GO TO 600
C       F - FUNCTION GENERATOR
80      NF=MTRX5(I)
        P3=P1-P2
        IF (P3.LE.0.0) GO TO 750
        P1=10.0*(CJ-P2)/P3
        IF (P1.GT.0.0) GO TO 90
        CI=F(NF,1)
        GO TO 600
90      NSECT=P1
        IF (NSECT.LT.10) GO TO 100
        CI=F(NF,11)
        GO TO 600
100     P2=NSECT
        P3=P1-P2
        P1=F(NF,NSECT+1)
        P2=F(NF,NSECT+2)
        CI=P1+P3*(P2-P1)
        GO TO 600
C       G - GAIN
110     CI=P1*CJ
        GO TO 600
C       H - HALF POWER (SQUARE ROOT)
120     IF (CJ.LT.0.0) GO TO 750
        CI=SQRT(CJ)
        GO TO 600
C       I - INTEGRATOR (MAXIMUM 25 ELEMENTS)
130     M=MTRX5(I)
        DYDT(M)=CJ+P2*CK+P3*CL
        GO TO 650
C       J - JITTER (RANDOM NUMBER GENERATOR BETWEEN + AND - 1)
140     IR=259*IR
        CI=FLOAT(IR)/131072.0
        GO TO 600
C       K - CONSTANT
C       L - LIMITER
150     IF (CJ.LT.P1) GO TO 160
        CI=P1
        GO TO 600
160     IF (CJ.GT.P2) GO TO 280
170     CI=P2
        GO TO 600
C       M - MAGNITUDE
180     CI=ABS(CJ)
        GO TO 600
C       N - NEGATIVE CLIPPER
190     IF (CJ.GT.0.0) GO TO 280
200     CI=0.0
        GO TO 600
C       O - OFFSET
210     CI=CJ+P1
        GO TO 600
C       P - POSITIVE CLIPPER
220     IF (CJ) 280,200,200
C       Q - QUIT
230     IF (CJ-CK) 650,650,850
C       R - RELAY
240     IF (CJ.LT.0.0) GO TO 260
250     CI=CK
        GO TO 600
260     CI=CL
        GO TO 600
C       S - SWITCH
270     M=P1
        IF (RSAC(M)) GO TO 250
280     CI=CJ
        GO TO 600
C       T -TIME PULSE GENERATOR
290     IF (TEST5-2) 300,200,330
300     MTRX5(I)=0
310     IF (CJ.LT.0.0) GO TO 200
        MTRX5(I)=1
320     PAR2(I)=-P1+DTS2+DT
        CI=1.0
        GO TO 600
330     IF (MTRX5(I).EQ.0) GO TO 310
        IF (P2.GE.0.0) GO TO 320
        PAR2(I)=P2+DT
        GO TO 200
C       U - UNIT DELAY
340     IF (TEST5.NE.1) C(I)=P2
        PAR2(I)=CJ
        GO TO 650
C       V - VACUOUS (USED IN CONJUNCTION WITH WYE ELEMENT)
350     IF (TEST5.EQ.1) MTRX5(I)=NEXT
        GO TO 650
C       W - WEIGHTED SUMMER
360     CI=CJ*P1+CK*P2+CL*P3
        GO TO 600
C       X - MULTIPLIER
370     CI=CJ*CK
        GO TO 600
C       Y - WYE(USED IN CONJUNCTION WITH VACUOUS ELEMENT)
380     IF (ABS(1.0-CK/CJ).LE.P1) GO TO 280
        IF (RSAC(0)) GO TO 800
        C(K)=(1.0-P2)*CJ+P2*CK
        NEXT=MTRX5(K)
        GO TO 20
C       Z - ZERO ORDER HOLD
390     IF (TEST5.NE.1) GO TO 400
        PAR2(I)=C(I)
        P2=C(I)
400     IF (CK.LE.0.0) GO TO 170
        PAR2(I)=CJ
        GO TO 280
C       + - SUMMER
410     IF (J) 420,430,440
420     J=-J
        CI=-C(J)
        GO TO 450
430     CI=0.0
        GO TO 450
440     CI=CJ
450     IF (K) 460,480,470
460     K=-K
        CI=CI-C(K)
        GO TO 480
470     CI=CI+CK
480     IF (L) 490,600,500
490     L=-L
        CI=CI-C(L)
        GO TO 600
500     CI=CI+CL
        GO TO 600
C       - - SIGN INVERTER
510     CI=-CJ
        GO TO 600
C       / - DIVIDER
520     IF (CK.EQ.0.0) GO TO 750
        CI=CJ/CK
C       1 - SPECIAL ELEMENT NUMBER 1
C       2 - SPECIAL ELEMENT NUMBER 2
C       3 - SPECIAL ELEMENT NUMBER 3
C       4 - SPECIAL ELEMENT NUMBER 4
C       5 - SPECIAL ELEMENT NUMBER 5
C       HAVE ALL BEEN DELETED
600     C(I)=CI
650     IF (NEXT-NLIST) 700,900,750
700     NEXT=NEXT+1
        GO TO 20
C       PROCESSING ERROR
750     TEST5=4
        RETURN
C       RUN TERMINATED BY SWITCH 0
800     TEST5=5
        RETURN
C       RUN TERMINATED BY QUIT ELEMENT
850     TEST5=6
900     RETURN
        END
CSM12
        SUBROUTINE CSM12
C       ACCUMULATOR SWITCH OPTIONS
        INTEGER TEST5
      INTEGER DKT,DK,PR,TTO,TTI,CD,LP,PP,PD
        LOGICAL RSAC
      CHARACTER*35 R(18)
        DIMENSION ISW(16),KEYS(16)
        COMMON REALS(395),INTS(547)
      COMMON /ASSIGN/DKT,DK,PR,TTO,TTI,CD,LP,PP,PD
        EQUIVALENCE (INTS(380),KEYS(1)),(INTS(529),TEST5)
      DATA R/
     * 'SWITCH 17 UP TO SUPPRESS FOLLOWING ',
     * '    OPTION                   SWITCH',
     * 'CONFIGURATION                     1',
     * 'INITIAL CONDITIONS OR PARAMETERS  2',
     * 'FUNCTION GENERATOR INTERCEPTS     3',
     * 'INTEGRATION SPECIFICATIONS        4',
     * 'PRINT INTERVAL                    5',
     * 'PRINT VARIABLES                   6',
     * 'PRINT ONLY                        7',
     * 'INTERROGATE BLOCK OUTPUTS         8',
     * 'OUTPUT ON LINE PRINTER            9',
     * 'PLOT ON DISPLAY                  10',
     * 'PUNCH UPDATED MODEL ON TAPE      11',
     * 'PRINT UPDATED MODEL              12',
     * 'INPUT FROM PAPER TAPE            13',
     * 'INPUT FROM CARD READER           14',
     * 'PLOT GRAPH ON PLOTTER            15',
     * 'DO NOT PLOT LABELS AND BORDER    16'/
        GO TO (70,70,70,50,10,30),TEST5
10      WRITE(PD,20)
      WRITE (TTO,20)
20      FORMAT(/27H RUN TERMINATED BY SWITCH 0/)
        GO TO 70
30      WRITE(PD,40)
      WRITE(TTO,40)
40      FORMAT(/31H RUN TERMINATED BY QUIT ELEMENT/)
        GO TO 70
50      WRITE(PD,60)
      WRITE (TTO,60)
60      FORMAT(/20H ERROR IN PROCESSING/)
70      TEST5=1
C       DEFINE THE SWITCH OPTIONS
        DO 90 I=1,18
        IF (RSAC(17)) GO TO 100
      WRITE (PD,*) R(I)
90      CONTINUE
100     WRITE(PD,110)
110     FORMAT(/44H AFTER SELECTING DESIRED OPTIONS TYPE CTRL P/)
        PAUSE
C
C  COPY GRAPH TO PLOTTER IF REQUESTED
C
      IF (.NOT.RSAC(15)) GO TO 112
      CALL PDINIT
      IF (.NOT.RSAC(16)) GO TO 111
      CALL DISPLY (3,1)
      CALL DISPLY (3,2)
      CALL DISPLY (3,3)
111   WRITE (TTO,*) 'SET UP FOR HARD COPY'
      CALL COPY
      GO TO 70
C
112   CALL CLEAR (.TRUE.)
C       GET THE SWITCH SETTINGS
        J=0
        DO 120 I=1,16
        KEYS(I)=2
        IF (.NOT.RSAC(I)) GO TO 120
        KEYS(I)=1
        J=J+1
        ISW(J)=I
120     CONTINUE
C       OUTPUT THE SWITCH SETTINGS
        WRITE(PD,130) (ISW(I),I=1,J)
      WRITE (TTO,130) (ISW(I),I=1,J)
130     FORMAT (/16H SWITCHES ON ARE,I3,15(1H,,I3))
        RETURN
        END
CSM13
        SUBROUTINE CSM13
C       BLOCK OUTPUT INTERROGATION
      INTEGER DKT,DK,PR,TTO,TTI,CD,LP,PP,PD
        DIMENSION C(75)
        COMMON REALS(395),INTS(547)
      COMMON /ASSIGN/DKT,DK,PR,TTO,TTI,CD,LP,PP,PD
        EQUIVALENCE (REALS(2),C(1))
        WRITE(PD,10)
10      FORMAT (/10X,28H OUTPUT INTERROGATION OPTION/)
20      WRITE(PD,30)
30      FORMAT(7H BLOCK=)
        I=KINPUT(0,IERR)
        IF (IERR) 90,40,50
40      IF (FINPUT(-1,IERR).NE.0.0) GO TO 50
        IF (I) 50,90,70
50      WRITE(PD,60)
60      FORMAT(5H WHAT)
        GO TO 20
70      IF (I.GT.75) GO TO 50
        WRITE(PD,80) I,C(I)
80      FORMAT(16H OUTPUT OF BLOCK,I3,4H IS ,G15.8)
        GO TO 20
90      RETURN
        END
C.FINPUT
        FUNCTION FINPUT(MODE,IERR)
C       TEST9 (IN COMMON)=COLUMN POINTER=COL
C       WHENEVER COL=-1, FINPUT WILL ECHO CURRENT RECORD TO THE TTY,
C                    AND READ A REPLACEMENT RECORD FROM THE TTY
C                    (THIS FACILITY IS FOR ERROR INDICATION TO THE USER)
C       WHENEVER COL=0, FINPUT WILL READ A NEW RECORD FROM THE TTY
C       AFTER COL HAS BEEN PROCESSED, THE MODE PARAMETER IS CHECKED-
C          MODE=-1 TO CHECK IF THERE ARE ANY UNPROCESSED ELEMENTS
C                  REMAINING UN THE CURRENT RECORD.
C                  IF THERE ARE NO MORE ELEMENTS - FINPUT=0.0
C                  IF THERE ARE SOME ELEMENTS - FINPUT=1.0
C                  IN EITHER CASE - COL=0
C          MODE=0 TO CHECK FOR A NUMERIC VALUE AS THE NEXT ELEMENT
C          MODE=+1 TO CHECK FOR AN ALPHANUMERIC CHARACTER STRING AS THE
C                  NEXT ELEMENT (ONLY THE FIRST CHARACTER IS RETAINED)
C             IN EITHER OF THE LATTER TWO CASES -
C                  IF THERE IS ANOTHER (OK) ELEMENT - IERR=0
C                                                     FINPUT=[VALUE]
C                  IF THERE ARE NO MORE ELEMENTS - IERR =-1
C                                                  COL=0
C                                                  FINPUT=0.0 (NUMERIC)
C                                                    OR BLANK (ALPHA)
C                  IF THERE IS ANOTHER ELEMENT OF
C                                  THE WRONG TYPE - IERR=+1
C                                                   COL=0
C                                                   FINPUT=0.0 (NUMERIC)
C                                                       OR BLANK (ALPHA)
C       NOTE THAT THE ABOVE SCHEME (WITH COL), IF PROPERLY UTILIZED,
C          WILL RESULT IN COL=0 AND A NEW RECORD BEING READ AUTOMATICALLY,
C          AT THE APPROPRIATE TIMES - IT IS ONLY NECESSARY TO INITIALIZE
C          COL (TEST9) = 0.
C       NUMERIC ELEMENTS ARE DELIMITED BY BLANKS,COMMAS,$,OR MODE CHANGE
C       ALPHANUMERIC ELEMENTS ARE DELIMITED BY BLANKS, COMMAS, AND $
C       $ IS THE RECORD TERMINATOR
C       FINPUT OPERATES ON 72-CHARACTER INPUT RECORDS
C       NUMERIC ELEMENTS MAY BE INTEGER, FIXED POINT, OR FLOATING POINT
C       BE CAREFUL ABOUT E AND G (E FORMAT OR ALPHA CAN BE CONFUSING)
C
        INTEGER COL, TEST2
      INTEGER DKT,DK,PR,TTO,TTI,CD,LP,PP,PD
        LOGICAL DIGD,DIGE,ESW,NUMER,POINT
        DIMENSION DATUM(72),DIGIT(10),DVAL(10)
        COMMON REALS(395),INTS(547)
      COMMON /ASSIGN/DKT,DK,PR,TTO,TTI,CD,LP,PP,PD
        EQUIVALENCE (INTS(526),TEST2),(INTS(533),COL)
        DATA BLANK/1H /
        DATA COMMA/1H,/
        DATA DMINUS/1H-/
        DATA DOLLAR/1H$/
        DATA DPLUS/1H+/
        DATA DPOINT/1H./
        DATA E/1HE/
        DATA G/1HG/
        DATA DIGIT(1)/1H0/
        DATA DIGIT(2)/1H1/
        DATA DIGIT(3)/1H2/
        DATA DIGIT(4)/1H3/
        DATA DIGIT(5)/1H4/
        DATA DIGIT(6)/1H5/
        DATA DIGIT(7)/1H6/
        DATA DIGIT(8)/1H7/
        DATA DIGIT(9)/1H8/
        DATA DIGIT(10)/1H9/
        DATA DVAL(1)/0.0/
        DATA DVAL(2)/1.0/
        DATA DVAL(3)/2.0/
        DATA DVAL(4)/3.0/
        DATA DVAL(5)/4.0/
        DATA DVAL(6)/5.0/
        DATA DVAL(7)/6.0/
        DATA DVAL(8)/7.0/
        DATA DVAL(9)/8.0/
        DATA DVAL(10)/9.0/
C
C       BEGIN COL CHECK
        IF (COL) 10,30,60
C       ECHO CURRENT RECORD TO, AND READ NEW RECORD FROM, THE TELETYPE
C10      IF (TEST2.NE.TTI) WRITE(PD,20) (DATUM(I),I=1,40)
10    WRITE (PD,20) (DATUM(I),I=1,40)
20      FORMAT(1H ,40A1,4H****)
        READ(4,40) DATUM
        GO TO 50
C       READ NEW RECORDS FROM TEST2
30      READ(TEST2,40) DATUM
40      FORMAT(72A1)
C       INITIALIZE COLUMN POINTER
50      COL=1
C       GENERAL INITIALIZATION
60      IF (MODE) 70,70,80
70      FINPUT=0.0
        GO TO 90
80      FINPUT=BLANK
C       CHECK IF ANY ELEMENTS
90      IF (COL.GT.72) GO TO 100
        IF (DATUM(COL).NE.DOLLAR) GO TO 110
C       NO ELEMENTS REMAINING
100     IERR=-1
        GO TO 400
C       THERE IS SOME ELEMENTS
110     IF (MODE) 120,130,130
C       CALLER DOES NOT WANT ANY MORE
120     FINPUT=1.0
        GO TO 400
C       IT IS OK TO HAVE AN ELEMENT
C       IGNORE LEADING BLANKS
130     DO 140 COL=COL,72
        IF (DATUM(COL).NE.BLANK) GO TO 150
140     CONTINUE
C       REACHED END-OF-RECORD - NULL ELEMENT
        GO TO 380
C       FOUND A NON-BLANK CHARACTER - CHECK IF NULL ELEMENT
150     CHAR=DATUM(COL)
        IF (CHAR.EQ.COMMA) GO TO 370
        IF (CHAR.EQ.DOLLAR) GO TO 380
C       THE ELEMENT IS NOT NULL
        IF (MODE) 230,200,160
C       TREAT IT AS AN ALPHANUMERIC CHARACTER STRING
160     DO 170 I=1,10
        IF (CHAR.EQ.DIGIT(I)) GO TO 230
170     CONTINUE
C       IT IS NOT A DIGIT - SAVE FIRST CHARACTER
        FINPUT=CHAR
C       MOVE PAST REMAINDER OF THE ALPHANUMERIC STRING
180     COL=COL+1
      IF (COL.GT.72) GO TO 380
        CHAR=DATUM(COL)
        IF (CHAR.EQ.DOLLAR) GO TO 380
        IF (CHAR.EQ.COMMA) GO TO 370
        IF (CHAR.EQ.BLANK) GO TO 360
        GO TO 180
C       TREAT IT AS NUMERIC
C       GENERAL NUMERIC INITIALIZATION
200     NUMER=.FALSE.
        ISIGND=0
        DIGD=.FALSE.
        POINT=.FALSE.
        DECIM=0.0
        ESW=.FALSE.
        IEXPO=0
C       CHARACTER SEARCH
210     DO 220 I=1,10
        IF (CHAR.EQ.DIGIT(I)) GO TO 240
220     CONTINUE
        IF (CHAR.EQ.DPLUS) GO TO 280
        IF (CHAR.EQ.DMINUS) GO TO 290
        IF (CHAR.EQ.DPOINT) GO TO 320
        IF (CHAR.EQ.E.OR.CHAR.EQ.G) GO TO 330
C       NON-NUMERIC TYPE CHARACTER
        IF (NUMER) GO TO 390
C       THIS ELEMENT IS OF THE WRONG TYPE - INDICATE ERROR
230     IERR=1
        GO TO 400
C       DIGIT
240     IF (ESW) GO TO 250
C       UPDATE FIXED POINT PART
        IF (POINT) IEXPO=IEXPO-1
        DIGD=.TRUE.
        R=DVAL(I)
        IF (ISIGND.EQ.(-1)) R=-R
        DECIM=10.0*DECIM+R
        GO TO 350
C       UPDATE EXPONENT PART
250     I=I-1
        IF (ISIGNE.EQ.(-1)) I=-I
        IEXPO=10*IEXPO+I
        IF (DIGD) GO TO 350
C       FIXED POINT PART WAS AT MOST A SIGN - CAN TAKE CARE OF THAT NOW
        IF (ISIGND) 260,350,270
260     DECIM=-1.0
        GO TO 350
270     DECIM=1.0
        GO TO 350
C       PLUS SIGN
280     I=1
        GO TO 300
C       MINUS SIGN
290     I=-1
300     IF (ESW) GO TO 310
C       NUMERIC SIGN
        IF (ISIGND.NE.0) GO TO 390
        ISIGND=I
        GO TO 350
C       EXPONENT SIGN
310     IF (ISIGNE.NE.0) GO TO 390
        ISIGNE=I
        GO TO 350
C       DECIMAL POINT
320     IF (POINT.OR.ESW) GO TO 390
        POINT=.TRUE.
        GO TO 350
C       E
330     IF (ESW) GO TO 390
C       EXPONENT PART INITIALIZATION
        ESW=.TRUE.
        ISIGNE=0
        DECIM=DECIM*10.0**IEXPO
        IEXPO=0
C       GET NEXT CHARACTER
350     NUMER=.TRUE.
        COL=COL+1
        IF (COL.GT.72) GO TO 390
        CHAR=DATUM(COL)
        IF (CHAR.EQ.COMMA) GO TO 390
        IF (CHAR.EQ.DOLLAR) GO TO 390
        IF (CHAR.NE.BLANK) GO TO 210
C       BLANK IS THE DELIMITER
        FINPUT=DECIM*10.0**IEXPO
C       IGNORE TRAILING BLANKS
360     COL=COL+1
        IF (COL.GT.72) GO TO 380
        CHAR=DATUM(COL)
        IF (CHAR.EQ.BLANK) GO TO 360
C       MOVE TO COLUMN AFTER A COMMA
370     IF (CHAR.EQ.COMMA) COL=COL+1
C       END OF SCAN - INDICATE NO ERROR
380     IERR=0
        RETURN
C       DELIMITER - FINISH UP
390     FINPUT=DECIM*10.0**IEXPO
        GO TO 370
C       ERROR OR END OF RECORD - RESET COLUMN POINTER TO ZERO
400     COL=0
        RETURN
        END
C.KINPUT
        FUNCTION KINPUT(MODE,IERR)
C       KINPUT EQUALS FINPUT ROUNDED TO INTEGER
        R=FINPUT(MODE,IERR)
        IF (R) 10,20,30
10      K=R-0.5
        GO TO 40
20      K=0
        GO TO 40
30      K=R+0.5
40      KINPUT=K
        RETURN
        END
C.INUNIT
        SUBROUTINE INUNIT
C       SET TEST2=NEW INPUT UNIT
        INTEGER TEST1,TEST2
      INTEGER DKT,DK,PR,TTO,TTI,CD,LP,PP,PD
        LOGICAL RSAC
        COMMON REALS(395),INTS(547)
      COMMON /ASSIGN/DKT,DK,PR,TTO,TTI,CD,LP,PP,PD
        EQUIVALENCE (INTS(525),TEST1),(INTS(526),TEST2)
C       GET NEW INPUT UNIT
        TEST2 =TTI
        IF (TEST1.EQ.1) GO TO 10
        IF (RSAC(14)) TEST2=CD
        IF (RSAC(13)) TEST2=PR
10      RETURN
        END
C.APDE8
      SUBROUTINE APDE8
C
C  SHORT SUBROUTINE TO USE WHEN USING LOADER AND SINGLE FILE.
C  WHEN USING 'CHAIN', THIS WILL BE REPLACED BY AN ASSEMBLY LANGUAGE
C  ROUTINE TO 'ASSIGN PDE 10' AT EXECUTION TIME.
C
      RETURN
      END
C.BDATA1
        BLOCK DATA
        COMMON/EXTRA2/TY(30)
      DATA TY(1)/'A'/
        DATA TY(2)/1HB/
        DATA TY(4)/1HD/
        DATA TY(6)/1HF/
        DATA TY(7)/1HG/
        DATA TY(8)/1HH/
        DATA TY(9)/1HI/
        DATA TY(10)/1HJ/
        DATA TY(11)/1HK/
        DATA TY(12)/1HL/
        DATA TY(13)/1HM/
        DATA TY(14)/1HN/
        DATA TY(15)/1HO/
        DATA TY(16)/1HP/
        DATA TY(17)/1HQ/
        DATA TY(18)/1HR/
        DATA TY(19)/1HS/
        DATA TY(20)/1HT/
        DATA TY(21)/1HU/
        DATA TY(22)/1HV/
        DATA TY(23)/1HW/
        DATA TY(24)/1HX/
        DATA TY(25)/1HY/
        DATA TY(26)/1HZ/
        DATA TY(27)/1H+/
        DATA TY(28)/1H-/
        DATA TY(29)/1H//
        DATA TY(30)/1H /
        END
C.BDATA2
      BLOCK DATA
      INTEGER DKT,DK,PR,TTO,TTI,CD,LP,PP,PD
      COMMON /ASSIGN/DKT,DK,PR,TTO,TTI,CD,LP,PP,PD
      DATA DKT/1/,DK/2/,PR/3/,TTO/4/,TTI/4/
      DATA CD/5/,LP/6/,PP/7/,PD/8/
      END
