Trailing-Edge
-
PDP-10 Archives
-
decuslib20-05
-
decus/20-0137/csmp/csmp.for
There is 1 other file named csmp.for in the archive. Click here to see a list.
00100 C THIS PROGRAM WAS OBTAINED FROM DECUS (NO. 10-122) AND
00200 C SUBSTANTIALLY MODIFIED AT WESTERN MICHIGAN UNIVERSITY.
00300 C CONTINUOUS SYSTEM MODELING PROGRAM
00400 C
00500 C CSMP MAIN PROGRAM
00600 C
00700 C CARNEGIE-MELLON UNIVERSITY
00800 C HYBRID COMPUTATION LABORATORY
00900 C JANUARY, 1969
01000 C
01100 C REVISED VERSION FOR THE PDP-10
01200 C WILLIAM CORWIN WORKING FOR
01300 C C. GORDON BELL
01400 C JANUARY 1971
01500 C
01600 C INSTALLED ON WMU - KALAMAZOO PDP-10
01700 C RUSSELL BARR III
01800 C MAY 1973
01900 C
02000 C BLOCKS A,C,E IMPLIMENTED AS LOADABLE FUNCTIONS
02100 C RUSSELL BARR III
02200 C APRIL 1974
02300 C
02400 C ADDED GRAPHICS MODIFICATION
02500 C RUSSELL BARR III
02600 C APRIL 1975
02700 C
02800 C TO MAKE SYSTEM COPIES:
02900 C
03000 C COM CSMP4,/FU:CSMPA CSMP,CSMP1,CSMP2,CSMP3,CSMP5,CSMP6,TIMES,USAGE
03100 C FUDGE
03200 C LOAD CSMPA,CSMP4,SYS:FORLIB/LIB %'SEG:LOW'
03300 C SAV CSMP
03400 C MA CSMP.CMD
03500 C IREL:CSMPA,REL:CSMP4/LIB,SYS:FORLIB/LIB %'SEG:LOW'
03600 C $EX$$
03700 C
03800 C LOAD ON SYS: CSMP.SAV, CSMP.CMD
03900 C LOAD ON REL: CSMPA.REL,CSMP4.REL
04000 C
04100 C
04200 C
04300 C NOTE: PLOT SUPPORT ROUTINES IN CSMP6.REL(NO SOURCE) COURTESY:
04400 C JHLIB - JOHN HERMAN - WMU PHYSIC DEPT.
04500 C PLOT10 - JOHN HERMAN AND TEKTRONICS CORP.
04600 C
04700 C
04800 C TO USE SAV VERSION:
04900 C R CSMP
05000 C
05100 C TO USE REL VERSION:
05200 C EXECUTE BLOCKA,BLOCKC,BLOCKE,SYS:@CSMP
05300 C
05400 C WHERE ANY OR ALL OF BLOCKA,C,E MAY BE OMITED TO USE THE
05500 C DEFAULT FUNCTIONS [(A) ALOG(CJ) ,(B) COS(CJ+3.14159265*P1) ,
05600 C (C) EXP(CJ) ].
05700 C
05800 C BLOCK? ARE OF THE FORM:
05900 C
06000 C FUNCTION BLOCKA(CJ,CK,CL,P1,P2,P3,JUMP)
06100 C [ ANY LEGAL FUNCTION THAT CONTAINS: BLOCKA= .....
06200 C IF AN ERROR RETURN THAT TERMINATES THE RUN IS DESIRED,
06300 C SET JUMP TO .TRUE.
06400 C ]
06500 C RETURN
06600 C END
06700 C
06800 C
06900 C CJ,CK,CL ARE INPUT VALUES FROM THE
07000 C BLOCKS I1,I2,I3 RESPECTIVELY.
07100 C P1,P2,P3 ARE INPUT PARAMETERS 1,2, AND 3 RESPECTIVELY
07200 C
07300 C
07400
07500 INTEGER SEMI,BLANK,REENTE,PNUM,PDEV,PFILNA,STOPS,
07600 1COMMAN(18),IFILNA,OFILNA,CMD,ONUM,
07700 2TEST1,TEST2,TEST3,TEST4,TEST5,TEST7,TEST8,INPUT(80),FILS(15)
07800 C
07900 LOGICAL RSAC
08000 C
08100 DATA COMMAN/3HHEL,3HLOO,3HCON,3HPAR,3HFUN,3HPUN,
08200 13HINT,3HOUT,3HGOE,3HFIL,3HRES,3HEXI,3HTIM,
08300 23HPRI,3HPLO,3HRUN,3HINP,3HGRA/
08400 DATA PDEV/4HDSK0/,PFILNA/5HMODEL/,PNUM/24/,
08500 1ONUM/1/
08600 DATA IDEV/3HTTY/,ODEV/3HDSK/,IFILNA/5HINPUT/,
08700 1OFILNA/5HOUTPT/
08800 DATA BLANK/1H /,SEMI/1H;/,REENTE/0/
08900 C
09000 COMMON /ODEVIM/ONUM
09100 COMMON /PDEVIM/PNUM
09200 COMMON /NOSTOP/ITHROU
09300 COMMON REALS(395),INTS(547)
09400 COMMON/NOPR/INPVAR
09500 C
09600 EQUIVALENCE (INTS(380),KEY1),(INTS(381),KEY2),(INTS(382),KEY3)
09700 EQUIVALENCE (INTS(383),KEY4),(INTS(386),KEY7),(INTS(387),KEY8)
09800 EQUIVALENCE (INTS(525),TEST1),(INTS(526),TEST2)
09900 EQUIVALENCE (INTS(527),TEST3),(INTS(528),TEST4)
10000 EQUIVALENCE (INTS(531),TEST7),(INTS(529),TEST5)
10100 C
10200 C TIME INITIALIZATION SUBROUTINE
10300 C
10400 CALL TIMES(IJ,J,K,0)
10500 C
10600 C WHAT IF THE SYSTEM BOMBED AND YOU WANT BACK IN?
10700 C
10800 IF(REENTE.NE.1) GO TO 1
10900 C
11000 C WELL THIS LITTLE VARIABLE WILL LET YOU IN
11100 C
11200 WRITE (30,5)
11300 WRITE (30,2)
11400 TEST5=1
11500 REENTE=1
11600 CALL OFILE(ONUM,OFILNA)
11700 GO TO 20
11800 5 FORMAT (/' TO CLEAR TYPE "RESTART"'//)
11900 C
12000 C THIS IS THE NORMAL ENTRY- IT ZEROS EVERYTHING
12100 C CSM0 IS TH INITIALIZATION SUBROUTINE THAT ZEROS EVERYTING
12200 C
12300 C
12400 1 CALL CSM0
12500 TEST2=5
12600 IF(IRESTA.EQ.1)TEST2=IOLD
12700 IRESTA=0
12800 STOPS=1
12900 REENTE=1
13000 C SET UP OUTPUT FILE WITH A NAME
13100 CALL OFILE (ONUM,OFILNA)
13200 WRITE (30,2)
13300 2 FORMAT (' FOR HELP TYPE "HELP"'/)
13400 C
13500 C TEST5 CONTAINS A VALUE DEPENDING ON THE RETURN
13600 C SOME ARE ERROR RETURNS
13700 C
13800 10 GO TO (20,20,20,30,40,50)TEST5
13900 30 WRITE (30,31)
14000 GO TO 20
14100 31 FORMAT (/20H ERROR IN PROCESSING/)
14200 40 WRITE (30,41)
14300 GO TO 20
14400 41 FORMAT (/24H RUN TERMINATED BY A "^"/)
14500 50 WRITE (30,51)
14600 GO TO 20
14700 51 FORMAT (/33H RUN TERMINATED BY A QUIT ELEMENT/)
14800 C
14900 C HERE WE COME BACK TO THE SAME OLD POINT
15000 C IT IS TIME TO GET MORE COMMANDS
15100 C
15200 20 TEST5=1
15300 WRITE (30,22)
15400 22 FORMAT (2H *$)
15500 DO 23 J=1,80
15600 23 INPUT(J)=0
15700 READ (5,21)INPUT
15800 21 FORMAT (80A1)
15900 I=1
16000 C
16100 C NOW TO SEPARATE THE COMMAND OUT OF THE INPUT
16200 C
16300 60 CMD=(INPUT(I).AND."774000000000).OR.((INPUT(I+1)/128)
16400 1.AND."3760000000).OR.((INPUT(I+2)/16384).AND."17777776)
16500 INPVAR=0
16600 DO 70 J=1,18
16700 C
16800 C IS IT A VALID COMMAND, ASK THE ARRAY 'COMMAN'
16900 C AND THEN JUMP OUT OF THIS LOOP
17000 C
17100 70 IF (CMD.EQ.COMMAN(J))GO TO (120,130,140,150,160,170,180,
17200 1190,200,210,220,230,240,250,260,270,280,290)J
17300 GO TO 1100
17400 C
17500 C CAN'T FIND THE COMMAND - MUST BE AN ERROR
17600 C
17700 C NOW TO EXECUTE THE COMMANDS
17800 C
17900 120 CALL CSM12
18000 C
18100 C THIS COMMAND WAS THE "HELP" COMMAND, SO CALL THE SUBROUTINE
18200 C WITH ALL THE HELP
18300 C
18400 GO TO 1000
18500 130 TEST2=5
18600 C
18700 C NOW WE WANT TO LOOK AT THE BLOCK OUTPUTS
18800 C FIRST SET TEST2 (THE INPUT DEVICE NUMBER) EQUAL TO 5(TTY)
18900 C THEN CALL THE INTERROGATION ROUTINE
19000 C
19100 CALL CSM13
19200 GO TO 1000
19300 140 TEST1=2
19400 C
19500 C CONFIGURATION- SO YOU WANT TO SET UP A MODEL
19600 C FIRST SET THE ERROR INDICATOR TO 2 SO WE CAN SEE AN ERROR
19700 C
19800 C SET UP THE INPUT FILE
19900 C
20000 CALL IFILE(TEST2,IFILNA)
20100 C
20200 C THEN GO TO THE INPUT SECTION
20300 C
20400 CALL CSM1
20500 C
20600 C NOW THE PRESORT SECTION
20700 C
20800 CALL CSM2
20900 C
21000 C BUT WAS THERE AN ERROR?
21100 C
21200 IF (TEST1.NE.1)GO TO 141
21300 143 WRITE (30,142)
21400 C
21500 C THERE MUST HAVE BEEN, SO TELL HIM AND SEE IF HE HAS SOME
21600 C BRIGHT IDEAS
21700 C BUT DON'T LET HIM GET PAST THIS POINT
21800 C
21900 STOPS=1
22000 GO TO 1000
22100 142 FORMAT (/27H CONFIGURATION NOT COMPLETE/)
22200 141 CALL CSM3
22300 C
22400 C NO ERROR SO SORT THE MODEL AND TEST AGAIN
22500 C
22600 IF (TEST1.EQ.1) GO TO 143
22700 STOPS=0
22800 GO TO 1000
22900 150 IF (STOPS.GT.0) GO TO 143
23000 C
23100 C DON'T LET HIM IN IF HE ISN'T DONE
23200 C HE'S IN? OK, GET THE PARAMETERS
23300 C
23400 CALL CSM4
23500 STOPS=-1
23600 IF (TEST4.EQ.1) GO TO 163
23700 GO TO 1000
23800 160 IF (STOPS.EQ.1)GO TO 143
23900 IF(STOPS.LE.-1)GO TO 161
24000 C
24100 C HELP HIM FIND HIS ERROR, BUT LET HIM THROUGH (161) IF IT'S
24200 C ALL RIGHT
24300 C
24400 WRITE (30,162)
24500 GO TO 1000
24600 162 FORMAT(24H PARAMETERS NOT COMPLETE)
24700 161 IF (TEST4.EQ.1) GO TO 163
24800 C
24900 C TEST4 TELLS IF THERE ARE ANY FUNCTIONS IN THE MODEL
25000 C IF THERE ARE LET HIM SPECIFY THEM
25100 C
25200 CALL CSM5
25300 163 WRITE (30,164)
25400 C
25500 C THE MODEL IS NOW ALL SET UP- ON THE OUTPUT PARAMETERS,
25600 C WHICH ARE CHANGABLE
25700 C
25800 TEST2=5
25900 TEST3=2
26000 STOPS=-2
26100 GO TO 1000
26200 164 FORMAT (15H MODEL COMPLETE)
26300 170 IF(STOPS.GE.-1) GO TO 171
26400 IF (TEST3.NE.2) GO TO 171
26500 C
26600 C SO YOU WANT TO OUTPUT THE MODEL, FIRST CHECK TO SEE IF
26700 C YOU ARE DONE TO THIS STAGE, YOU ARE? OK CALL CSM6 TO DO
26800 C THE ACTUALL OUTPUTING OF THE MODEL
26900 C
27000 C SET UP PUNCH OUTPUT FILE
27100 CALL OFILE(PNUM,PFILNA)
27200 C
27300 C
27400 CALL CSM6
27500 GO TO 1000
27600 171 WRITE (30,172)
27700 GO TO 1000
27800 172 FORMAT (19H MODEL NOT COMPLETE)
27900 180 IF(STOPS.LE.-2)GO TO 181
28000 IF(TEST3.NE.2) GO TO 171
28100 C
28200 C NOW TO SPECIFY THE INTEGRATION PARAMETERS
28300 C
28400 181 CALL CSM7
28500 STOPS=-3
28600 GO TO 1000
28700 190 IF (STOPS.GE.-2) GO TO 171
28800 C
28900 C SPECIFY THE OUTPUT PARAMETERS TO MAKE IT PRETTY
29000 C
29100 CALL CSM8A(IOFSET)
29200 STOPS=-4
29300 GO TO 1000
29400 191 WRITE (30,192)
29500 GO TO 1000
29600 192 FORMAT (34H INTEGRATION SPECIFICATIONS NEEDED)
29700 200 IF (STOPS.NE.-4) GO TO 201
29800 ITHROU=1
29900 C
30000 C NOW FOR THE DIRTY WORK. CSM8A, BESIDES GETTING THE OUTPUT
30100 C PARAMETERS ALSO PRINTS THE HEADING. THIS CAN CAUSE PROBLEMS
30200 C SO USE A VARIBLE TO LET YOU DO ONE OR THE OTHER BUT NOT
30300 C BOTH, THIS VARIABLE IS ITHROU.
30400 C
30500 C BUT DON'T WANT TO SET UP THE SAME OLD FILE IF IT HAS ALREADY
30600 C INITIALIZED
30700 C
30800 CALL CSM8A(IOFSET)
30900 ITHROU=0
31000 C
31100 C RESET ITHROU AND THEN GO ON TO EXECUTE THE MODEL
31200 C
31300 CALL CSM10(IOFSET)
31400 GO TO 1000
31500 201 WRITE (30,202)
31600 GO TO 1000
31700 202 FORMAT (16H MORE WORK TO DO)
31800 C
31900 C NOW TO MAKE USE OF THE PDP-10'S MANY DEVICES
32000 C FIRST PRINT OUT THE OLD DEVICE NAME
32100 C THE FILE NAME CAN ONLY BE FIVE CHARACTERS IN LENGTH
32200 C WITH NO EXTENSION- THANKS TO IFILE AND OFILE
32300 C
32400 210 WRITE (30,211)IDEV,IFILNAM
32500 C
32600 C FIRST DO THE INPUT DEVICE
32700 C
32800 211 FORMAT (' OLD INPUT FILE WAS ',A4,':',A5,
32900 1' REPLACE WITH '$)
33000 212 FORMAT (15A1)
33100 READ (5,212)FILS
33200 C
33300 C AFTER READING IT IN CALL GETNAM TO GET THE NAME FROM THE
33400 C INPUT
33500 C
33600 CALL GETNAM(FILS,IDEV,IFILNA,TEST2)
33700 C
33800 C BUT THERE ARE SOME DEVICES THAT CAN'T BE USED FOR INPUT
33900 C
34000 IF(TEST2.EQ.3.OR.TEST2.EQ.7.OR.TEST2.EQ.8)GOTO 210
34100 C
34200 214 WRITE (30,213)ODEV,OFILNA
34300 213 FORMAT (' OLD OUTPUT FILE WAS ',A4,':',
34400 1A5,' REPLACE WITH '$)
34500 C
34600 READ (5,212)FILS
34700 ITMP1=OFILNA
34800 ITMP2=ONUM
34900 CALL GETNAM(FILS,ODEV,OFILNA,ONUM)
35000 IF(ITMP1.EQ.OFILNA.AND.ITMP2.EQ.ONUM)GO TO 216
35100 ENDFILE (ITMP2)
35200 CALL RELEAS (ITMP2)
35300 CALL OFILE (ONUM,OFILNA)
35400 216 CONTINUE
35500 C
35600 C DO THE SAME FOR THE OUTPUT FILES
35700 C
35800 IF(ONUM.EQ.2.OR.ONUM.EQ.6)GO TO 214
35900 WRITE(30,215)PDEV,PFILNA
36000 215 FORMAT (' OLD MODEL OUTPUT FILE WAS ',A4,':',A5,
36100 1' REPLACE WITH '$)
36200 C
36300 READ (5,212)FILS
36400 CALL GETNAM(FILS,PDEV,PFILNA,PNUM)
36500 C
36600 C AND LAST BUT NOT LEAST FOR THE PUNCH OR MODEL OUTPUT FILE
36700 C
36800 GO TO 1000
36900 220 WRITE (30,221)
37000 C
37100 C THIS PART OF THE PROGRAM DOES A 'RESTART'
37200 C IT CALLS TIME TO FIND, AND RESET THE TIMES
37300 C IT THEN JUMPS OFF TO THE START OF THE PROGRAM TO
37400 C ZERO OUT EVERYTHING
37500 C
37600 CALL TIMES(IJ,J,K,2)
37700 A=IJ/1000.
37800 WRITE (30,232)A
37900 WRITE (30,233)J,K
38000 IRESTA=1
38100 IOLD=TEST2
38200 CALL RELEA
38300 GO TO 1
38400 221 FORMAT (/' RESTART IN PROGRESS'/)
38500 230 WRITE (30,231)
38600 C
38700 C THIS IS THE PART THAT CAUSES AN EXIT FROM THE PROGRAM
38800 C IF FOR SOME REASON YOU WANT TO STOP AND DON'T WANT TO HIT
38900 C CONTROL C (SO WHAT IF ALL YOU FILES MIGHT NOT BE SAFE UNDER
39000 C A CONTROL C, IT'S FASTER)
39100 C
39200 231 FORMAT (//' END OF RUN')
39300 CALL TIMES(IJ,J,K,1)
39400 C
39500 C OUTPUT THE TIMES
39600 C
39700 A=IJ/1000.
39800 WRITE (30,232)A
39900 232 FORMAT (' TOTAL CPU TIME FOR RUN ',F8.3,' SECONDS')
40000 WRITE (30,233)J,K
40100 C
40200 C NOW LEAVE THE PROGRAM TO SEE FORTANS EXIT TIMES
40300 C
40400 STOP
40500 233 FORMAT (' ELAPSED TIME 'I4,' MIN ',I2,' SECONDS')
40600 C
40700 C NOW TO FIND OUT WHAT TIME IT IS AND TO RESET THE TIME
40800 C
40900 240 CALL TIMES(IJ,J,K,2)
41000 A=IJ/1000.
41100 WRITE (30,232)A
41200 WRITE (30,233)J,K
41300 GO TO 1000
41400 C
41500 C THE NEXT TWO TELL WHETHER YOU WANT PRINTED OR PLOTED OUTPUT
41600 C
41700 250 KEY7=1
41800 C
41900 C OK, MAKE IT A PRINT JOB
42000 C
42100 IF(STOPS.LT.-3)STOPS=-3
42200 C
42300 C OK, CHANGE THE WAY IT'S OUTPUT AND BETTER GET THE NEEDED
42400 C INFORMATION
42500 C
42600 GO TO 1000
42700 260 KEY7=2
42800 C
42900 C OK, MAKE IT A PLOT JOB
43000 C
43100 IF(STOPS.LT.-3)STOPS=-3
43200 GO TO 1000
43300 C
43400 C THIS IS FOR THE RUN COMMAND
43500 C IT IS MAINLY TO SAVE TYPING FINGERS
43600 C
43700 270 GO TO (271,272,273,274,275,276)STOPS+5
43800 C
43900 C FIRST DECIDE WHERE THE USER IS AND PICK UP WHERE HE LEFT OFF
44000 C
44100 GO TO 1100
44200 276 IF (RSAC(0)) GO TO 1000
44300 IF(TEST2.NE.5)CALL IFILE(TEST2,IFILNA)
44400 CALL CSM1
44500 CALL CSM2
44600 IF (TEST1.NE.1)GO TO 2761
44700 2762 WRITE (30,142)
44800 GO TO 276
44900 2761 CALL CSM3
45000 IF(TEST1.EQ.1)GO TO 2762
45100 STOPS=0
45200 IF(RSAC(0)) GO TO 1000
45300 275 CALL CSM4
45400 STOPS=-1
45500 IF(RSAC(0)) GO TO 1000
45600 IF(TEST4.EQ.1) GO TO 2741
45700 274 CALL CSM5
45800 2741 WRITE(30,164)
45900 TEST2=5
46000 TEST3=2
46100 STOPS=-2
46200 IF(RSAC(0)) GO TO 1000
46300 IF(INPVAR.EQ.-1)GO TO 1000
46400 273 IF (TEST7.EQ.2) GO TO 272
46500 CALL CSM7
46600 STOPS=-3
46700 IF(RSAC(0)) GO TO 1000
46800 272 IF(TEST8.EQ.2) GO TO 271
46900 CALL CSM8A(IOFSET)
47000 STOPS=-4
47100 IF(RSAC(0)) GO TO 1000
47200 C
47300 C THE TESTS OF TEST7 AND 8 WERE TO DETERMINE IF THEY HAVE
47400 C ALREADY BEEN ENTERED AND SO DON'T ASK FOR THEM AGAIN
47500 C
47600 271 STOPS=-4
47700 ITHROU=1
47800 CALL CSM8A(IOFSET)
47900 ITHROU=0
48000 CALL CSM10(IOFSET)
48100 GO TO 1000
48200 C
48300 C INP READS IN A MODEL BUT DOES NOT RUN OR ECHO IT.
48400 C
48500 280 IF(STOPS.GE.1)GO TO 281
48600 WRITE(30,282)
48700 282 FORMAT(' USE RESTART COMMAND FOR NEW MODEL',/)
48800 GO TO 1000
48900 281 INPVAR=-1
49000 GO TO 270
49100 C
49200 C THE GRAPH OPTION SETUP.
49300 C
49400 290 KEY7=-1
49500 IF(STOPS.LT.-3)STOPS=-3
49600 C SINCE THE USER MAY HAVE (SOMEHOW) SWITCHED TERMINALS
49700 C SINCE THE LAST RUN TYPE COMMAND WE SHOULD GET NEW
49800 C INFO. (ALSO IF HE MADE A MISTAKE THE FIRST TIME
49900 C LET HIM CORRECT IT.)
50000 CALL DELETE('TRMNL.DAT')
50100 TYPE=0
50200 ITYPE=0
50300 C DUMMY TO INIT TERMINAL VALUES.(NORMAL USE OF THE
50400 C GPLOT ROUTINES, CALLS FOR USE OF PLOTTE FROM INSIDE
50500 C ONLY.
50600 C CALL PLOTTE(TYPE,ITYPE)
50700 GO TO 1000
50800 C
50900 C THIS IS WHERE EVERYTHING ENDS UP
51000 C
51100 1000 DO 1001 J=I+3,80
51200 C
51300 C IF THE INPUT HAS A SCMICOLON IN IT BE PREPARED FOR ANOTHER
51400 C COMMAND
51500 C
51600 IF (INPUT(J).EQ.SEMI) GO TO 1010
51700 C
51800 C IF THE INPUT IS ZERO THEN EXIT, ELSE LOOP
51900 C
52000 1001 IF (INPUT(J).EQ.0) GO TO 10
52100 GO TO 10
52200 1010 IF((INPUT(J+1).EQ.0).OR.(INPUT(J+1).EQ.BLANK))GO TO 10
52300 I=J+1
52400 IF(TEST5.GT.3) GO TO 10
52500 GO TO 60
52600 C
52700 C IF THERE WAS AN ERROR COME HERE
52800 C HOWEVER, LET THE USER HAVE A BLANK COMMAND
52900 C
53000 1100 IF(CMD.EQ.BLANK)GO TO 20
53100 WRITE (30,1101)
53200 GO TO 20
53300 1101 FORMAT (' COMMAND ERROR- FOR HELP TYPE "HELP"')
53400 END