C CONTINUOUS SYSTEM MODELING PROGRAM C C 9 SEP 75 (PDH.15) REMOVE 'INCRMT' FROM THIS FILE, AS IT HAS BEEN C ADDED TO THE LIBRARY. 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 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